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.12 2004-12-20 00:32:15 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)
134 (defbinding visual-get-best-depth () int)
136 (defbinding visual-get-best-type () visual-type)
138 (defbinding visual-get-system () visual)
141 (defbinding (%visual-get-best-with-nothing "gdk_visual_get_best") () visual)
143 (defbinding %visual-get-best-with-depth () visual
146 (defbinding %visual-get-best-with-type () visual
149 (defbinding %visual-get-best-with-both () visual
153 (defun visual-get-best (&key depth type)
155 ((and depth type) (%visual-get-best-with-both depth type))
156 (depth (%visual-get-best-with-depth depth))
157 (type (%visual-get-best-with-type type))
158 (t (%visual-get-best-with-nothing))))
160 ;(defbinding query-depths ..)
162 ;(defbinding query-visual-types ..)
164 (defbinding list-visuals () (glist visual))
169 (defbinding window-destroy () nil
173 (defbinding window-at-pointer () window
177 (defbinding window-show () nil
180 (defbinding window-show-unraised () nil
183 (defbinding window-hide () nil
186 (defbinding window-is-visible-p () boolean
189 (defbinding window-is-viewable-p () boolean
192 (defbinding window-withdraw () nil
195 (defbinding window-iconify () nil
198 (defbinding window-deiconify () nil
201 (defbinding window-stick () nil
204 (defbinding window-unstick () nil
207 (defbinding window-maximize () nil
210 (defbinding window-unmaximize () nil
213 (defbinding window-fullscreen () nil
216 (defbinding window-unfullscreen () nil
219 (defbinding window-set-keep-above () nil
223 (defbinding window-set-keep-below () nil
227 (defbinding window-move () nil
232 (defbinding window-resize () nil
237 (defbinding window-move-resize () nil
244 (defbinding window-scroll () nil
249 (defbinding window-reparent () nil
255 (defbinding window-clear () nil
258 (defbinding %window-clear-area () nil
260 (x int) (y int) (width int) (height int))
262 (defbinding %window-clear-area-e () nil
264 (x int) (y int) (width int) (height int))
266 (defun window-clear-area (window x y width height &optional expose)
268 (%window-clear-area-e window x y width height)
269 (%window-clear-area window x y width height)))
271 (defbinding window-raise () nil
274 (defbinding window-lower () nil
277 (defbinding window-focus () nil
279 (timestamp unsigned-int))
281 (defbinding window-register-dnd () nil
284 (defbinding window-begin-resize-drag () nil
290 (timestamp unsigned-int))
292 (defbinding window-begin-move-drag () nil
297 (timestamp unsigned-int))
301 (defbinding window-set-user-data () nil
305 (defbinding window-set-override-redirect () nil
307 (override-redirect boolean))
309 ; (defbinding window-add-filter () nil
311 ; (defbinding window-remove-filter () nil
313 (defbinding window-shape-combine-mask () nil
319 (defbinding window-set-child-shapes () nil
322 (defbinding window-merge-child-shapes () nil
326 (defbinding window-set-static-gravities () boolean
328 (use-static boolean))
330 ; (defbinding add-client-message-filter ...
332 (defbinding window-set-cursor () nil
334 (cursor (or null cursor)))
336 (defbinding window-get-pointer () window
340 (mask modifier-type :out))
342 (defbinding %window-get-toplevels () (glist window))
344 (defun window-get-toplevels (&optional screen)
346 (error "Not implemented")
347 (%window-get-toplevels)))
349 (defbinding %get-default-root-window () window)
351 (defun get-root-window (&optional display)
353 (error "Not implemented")
354 (%get-default-root-window)))
362 (defbinding drag-status () nil
363 (context drag-context)
365 (time (unsigned 32)))
374 (defbinding rgb-init () nil)
381 (defmethod initialize-instance ((cursor cursor) &key type mask fg bg
382 (x 0) (y 0) (display (display-get-default)))
384 (slot-value cursor 'location)
386 (keyword (%cursor-new-for-display display type))
387 (pixbuf (%cursor-new-from-pixbuf display type x y))
388 (pixmap (%cursor-new-from-pixmap type mask fg bg x y)))))
391 (defbinding %cursor-new-for-display () pointer
393 (cursor-type cursor-type))
395 (defbinding %cursor-new-from-pixmap () pointer
402 (defbinding %cursor-new-from-pixbuf () pointer
407 (defbinding %cursor-ref () pointer
410 (defbinding %cursor-unref () nil
413 (defmethod reference-foreign ((class (eql (find-class 'cursor))) location)
414 (declare (ignore class))
415 (%cursor-ref location))
417 (defmethod unreference-foreign ((class (eql (find-class 'cursor))) location)
418 (declare (ignore class))
419 (%cursor-unref location))
424 (defbinding pixmap-new (width height depth &key window) pixmap
428 (window (or null window)))
430 (defbinding %pixmap-colormap-create-from-xpm () pixmap
431 (window (or null window))
432 (colormap (or null colormap))
434 (color (or null color))
437 (defbinding %pixmap-colormap-create-from-xpm-d () pixmap
438 (window (or null window))
439 (colormap (or null colormap))
441 (color (or null color))
442 (data (vector string)))
444 (defun pixmap-create (source &key color window colormap)
446 (if (not (or window colormap))
449 (multiple-value-bind (pixmap mask)
451 ((or string pathname)
452 (%pixmap-colormap-create-from-xpm
453 window colormap color (namestring (truename source))))
455 (%pixmap-colormap-create-from-xpm-d window colormap color source)))
456 ;; (unreference-instance pixmap)
457 ;; (unreference-instance mask)
458 (values pixmap mask))))
464 (defun %scale-value (value)
467 (float (truncate (* value 65535)))))
469 (defmethod initialize-instance ((color color) &rest initargs
471 (declare (ignore initargs))
473 (with-slots ((%red red) (%green green) (%blue blue)) color
475 %red (%scale-value red)
476 %green (%scale-value green)
477 %blue (%scale-value blue))))
479 (defun ensure-color (color)
485 'color :red (svref color 0) :green (svref color 1)
486 :blue (svref color 2)))))
492 (defbinding drawable-get-size () nil
497 (defbinding (drawable-width "gdk_drawable_get_size") () nil
502 (defbinding (drawable-height "gdk_drawable_get_size") () nil
507 ;; (defbinding drawable-get-clip-region () region
508 ;; (drawable drawable))
510 ;; (defbinding drawable-get-visible-region () region
511 ;; (drawable drawable))
513 (defbinding draw-point () nil
514 (drawable drawable) (gc gc)
517 (defbinding %draw-points () nil
518 (drawable drawable) (gc gc)
522 ;; (defun draw-points (drawable gc &rest points)
526 (defbinding draw-line () nil
527 (drawable drawable) (gc gc)
531 ;; (defbinding draw-lines (drawable gc &rest points) nil
532 ;; (drawable drawable) (gc gc)
533 ;; (points (vector point))
534 ;; ((length points) int))
536 (defbinding draw-pixbuf
537 (drawable gc pixbuf src-x src-y dest-x dest-y &optional
538 width height (dither :none) (x-dither 0) (y-dither 0)) nil
539 (drawable drawable) (gc (or null gc))
541 (src-x int) (src-y int)
542 (dest-x int) (dest-y int)
543 ((or width -1) int) ((or height -1) int)
545 (x-dither int) (y-dither int))
547 ;; (defbinding draw-segments (drawable gc &rest points) nil
548 ;; (drawable drawable) (gc gc)
549 ;; (segments (vector segments))
550 ;; ((length segments) int))
552 (defbinding draw-rectangle () nil
553 (drawable drawable) (gc gc)
556 (width int) (height int))
558 (defbinding draw-arc () nil
559 (drawable drawable) (gc gc)
562 (width int) (height int)
563 (angle1 int) (angle2 int))
565 ;; (defbinding draw-polygon (drawable gc &rest points) nil
566 ;; (drawable drawable) (gc gc)
567 ;; (points (vector point))
568 ;; ((length points) int))
570 ;; (defbinding draw-trapezoid (drawable gc &rest points) nil
571 ;; (drawable drawable) (gc gc)
572 ;; (points (vector point))
573 ;; ((length points) int))
575 ;; (defbinding %draw-layout-line () nil
576 ;; (drawable drawable) (gc gc)
579 ;; (line pango:layout-line))
581 ;; (defbinding %draw-layout-line-with-colors () nil
582 ;; (drawable drawable) (gc gc)
585 ;; (line pango:layout-line)
586 ;; (foreground (or null color))
587 ;; (background (or null color)))
589 ;; (defun draw-layout-line (drawable gc font x y line &optional foreground background)
590 ;; (if (or foreground background)
591 ;; (%draw-layout-line-with-colors drawable gc font x y line foreground background)
592 ;; (%draw-layout-line drawable gc font x y line)))
594 (defbinding %draw-layout () nil
595 (drawable drawable) (gc gc)
598 (layout pango:layout))
600 (defbinding %draw-layout-with-colors () nil
601 (drawable drawable) (gc gc)
604 (layout pango:layout)
605 (foreground (or null color))
606 (background (or null color)))
608 (defun draw-layout (drawable gc font x y layout &optional foreground background)
609 (if (or foreground background)
610 (%draw-layout-with-colors drawable gc font x y layout foreground background)
611 (%draw-layout drawable gc font x y layout)))
613 (defbinding draw-drawable
614 (drawable gc src src-x src-y dest-x dest-y &optional width height) nil
615 (drawable drawable) (gc gc)
617 (src-x int) (src-y int)
618 (dest-x int) (dest-y int)
619 ((or width -1) int) ((or height -1) int))
621 (defbinding draw-image
622 (drawable gc image src-x src-y dest-x dest-y &optional width height) nil
623 (drawable drawable) (gc gc)
625 (src-x int) (src-y int)
626 (dest-x int) (dest-y int)
627 ((or width -1) int) ((or height -1) int))
629 (defbinding drawable-get-image () image
632 (width int) (height int))
634 (defbinding drawable-copy-to-image
635 (drawable src-x src-y width height &optional image dest-x dest-y) image
637 (image (or null image))
638 (src-x int) (src-y int)
639 ((if image dest-x 0) int)
640 ((if image dest-y 0) int)
641 (width int) (height int))
646 (defbinding keyval-name () string
647 (keyval unsigned-int))
649 (defbinding keyval-from-name () unsigned-int
652 (defbinding keyval-to-upper () unsigned-int
653 (keyval unsigned-int))
655 (defbinding keyval-to-lower ()unsigned-int
656 (keyval unsigned-int))
658 (defbinding (keyval-is-upper-p "gdk_keyval_is_upper") () boolean
659 (keyval unsigned-int))
661 (defbinding (keyval-is-lower-p "gdk_keyval_is_lower") () boolean
662 (keyval unsigned-int))