1 ;; Common Lisp bindings for GTK+ v2.0
2 ;; Copyright (C) 1999-2005 Espen S. Johnsen <espen@users@sf.net>
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.15 2005-02-27 12:37:45 espen Exp $
25 (defbinding (gdk-init "gdk_parse_args") () nil
26 "Initializes the library without opening the display."
34 (defbinding %display-open () display
35 (display-name (or null string)))
37 (defun display-open (&optional display-name)
38 (let ((display (%display-open display-name)))
39 (unless (display-get-default)
40 (display-set-default display))
43 (defbinding %display-get-n-screens () int
46 (defbinding %display-get-screen () screen
50 (defun display-screens (&optional (display (display-get-default)))
52 for i from 0 below (%display-get-n-screens display)
53 collect (%display-get-screen display i)))
55 (defbinding display-get-default-screen
56 (&optional (display (display-get-default))) screen
59 (defbinding display-beep (&optional (display (display-get-default))) nil
62 (defbinding display-sync (&optional (display (display-get-default))) nil
65 (defbinding display-flush (&optional (display (display-get-default))) nil
68 (defbinding display-close (&optional (display (display-get-default))) nil
71 (defbinding display-get-event
72 (&optional (display (display-get-default))) event
75 (defbinding display-peek-event
76 (&optional (display (display-get-default))) event
79 (defbinding display-put-event
80 (event &optional (display (display-get-default))) event
84 (defbinding (display-connection-number "clg_gdk_connection_number")
85 (&optional (display (display-get-default))) int
92 (defbinding display-get-default () display)
94 (defbinding (display-manager "gdk_display_manager_get") () display-manager)
96 (defbinding (display-set-default "gdk_display_manager_set_default_display")
98 ((display-manager) display-manager)
105 (defbinding (events-pending-p "gdk_events_pending") () boolean)
107 (defbinding event-get () event)
109 (defbinding event-peek () event)
111 (defbinding event-get-graphics-expose () event
114 (defbinding event-put () event
117 ;(defbinding event-handler-set () ...)
119 (defbinding set-show-events () nil
120 (show-events boolean))
122 (defbinding get-show-events () boolean)
125 ;;; Miscellaneous functions
127 (defbinding screen-width () int)
128 (defbinding screen-height () int)
130 (defbinding screen-width-mm () int)
131 (defbinding screen-height-mm () int)
133 (defun %grab-time (time-or-event)
134 (etypecase time-or-event
136 (timed-event (event-time time-or-event))
137 (integer time-or-event)))
139 (defbinding pointer-grab
140 (window &key owner-events events confine-to cursor time) grab-status
142 (owner-events boolean)
144 (confine-to (or null window))
145 (cursor (or null cursor))
146 ((%grab-time time) (unsigned 32)))
148 (defbinding (pointer-ungrab "gdk_display_pointer_ungrab")
149 (&optional (display (display-get-default)) time) nil
151 ((%grab-time time) (unsigned 32)))
153 (defbinding (pointer-is-grabbed-p "gdk_display_pointer_is_grabbed")
154 (&optional (display (display-get-default))) boolean)
156 (defbinding keyboard-grab (window &key owner-events time) grab-status
158 (owner-events boolean)
159 ((%grab-time time) (unsigned 32)))
161 (defbinding (keyboard-ungrab "gdk_display_keyboard_ungrab")
162 (&optional (display (display-get-default)) time) nil
164 ((%grab-time time) (unsigned 32)))
168 (defbinding atom-intern (atom-name &optional only-if-exists) atom
169 ((string atom-name) string)
170 (only-if-exists boolean))
172 (defbinding atom-name () string
179 (defbinding visual-get-best-depth () int)
181 (defbinding visual-get-best-type () visual-type)
183 (defbinding visual-get-system () visual)
186 (defbinding (%visual-get-best-with-nothing "gdk_visual_get_best") () visual)
188 (defbinding %visual-get-best-with-depth () visual
191 (defbinding %visual-get-best-with-type () visual
194 (defbinding %visual-get-best-with-both () visual
198 (defun visual-get-best (&key depth type)
200 ((and depth type) (%visual-get-best-with-both depth type))
201 (depth (%visual-get-best-with-depth depth))
202 (type (%visual-get-best-with-type type))
203 (t (%visual-get-best-with-nothing))))
205 ;(defbinding query-depths ..)
207 ;(defbinding query-visual-types ..)
209 (defbinding list-visuals () (glist visual))
214 (defbinding window-destroy () nil
218 (defbinding window-at-pointer () window
222 (defbinding window-show () nil
225 (defbinding window-show-unraised () nil
228 (defbinding window-hide () nil
231 (defbinding window-is-visible-p () boolean
234 (defbinding window-is-viewable-p () boolean
237 (defbinding window-withdraw () nil
240 (defbinding window-iconify () nil
243 (defbinding window-deiconify () nil
246 (defbinding window-stick () nil
249 (defbinding window-unstick () nil
252 (defbinding window-maximize () nil
255 (defbinding window-unmaximize () nil
258 (defbinding window-fullscreen () nil
261 (defbinding window-unfullscreen () nil
264 (defbinding window-set-keep-above () nil
268 (defbinding window-set-keep-below () nil
272 (defbinding window-move () nil
277 (defbinding window-resize () nil
282 (defbinding window-move-resize () nil
289 (defbinding window-scroll () nil
294 (defbinding window-reparent () nil
300 (defbinding window-clear () nil
303 (defbinding %window-clear-area () nil
305 (x int) (y int) (width int) (height int))
307 (defbinding %window-clear-area-e () nil
309 (x int) (y int) (width int) (height int))
311 (defun window-clear-area (window x y width height &optional expose)
313 (%window-clear-area-e window x y width height)
314 (%window-clear-area window x y width height)))
316 (defbinding window-raise () nil
319 (defbinding window-lower () nil
322 (defbinding window-focus () nil
324 (timestamp unsigned-int))
326 (defbinding window-register-dnd () nil
329 (defbinding window-begin-resize-drag () nil
335 (timestamp unsigned-int))
337 (defbinding window-begin-move-drag () nil
342 (timestamp unsigned-int))
344 ;; komplett så langt
346 (defbinding window-set-user-data () nil
350 (defbinding window-set-override-redirect () nil
352 (override-redirect boolean))
354 ; (defbinding window-add-filter () nil
356 ; (defbinding window-remove-filter () nil
358 (defbinding window-shape-combine-mask () nil
364 (defbinding window-set-child-shapes () nil
367 (defbinding window-merge-child-shapes () nil
371 (defbinding window-set-static-gravities () boolean
373 (use-static boolean))
375 ; (defbinding add-client-message-filter ...
377 (defbinding window-set-cursor () nil
379 (cursor (or null cursor)))
381 (defbinding window-get-pointer () window
385 (mask modifier-type :out))
387 (defbinding %window-get-toplevels () (glist window))
389 (defun window-get-toplevels (&optional screen)
391 (error "Not implemented")
392 (%window-get-toplevels)))
394 (defbinding %get-default-root-window () window)
396 (defun get-root-window (&optional display)
398 (error "Not implemented")
399 (%get-default-root-window)))
407 (defbinding drag-status () nil
408 (context drag-context)
410 (time (unsigned 32)))
419 (defbinding rgb-init () nil)
426 (defmethod initialize-instance ((cursor cursor) &key type mask fg bg
427 (x 0) (y 0) (display (display-get-default)))
429 (slot-value cursor 'location)
431 (keyword (%cursor-new-for-display display type))
432 (pixbuf (%cursor-new-from-pixbuf display type x y))
433 (pixmap (%cursor-new-from-pixmap type mask fg bg x y)))))
436 (defbinding %cursor-new-for-display () pointer
438 (cursor-type cursor-type))
440 (defbinding %cursor-new-from-pixmap () pointer
447 (defbinding %cursor-new-from-pixbuf () pointer
452 (defbinding %cursor-ref () pointer
455 (defbinding %cursor-unref () nil
458 (defmethod reference-foreign ((class (eql (find-class 'cursor))) location)
459 (declare (ignore class))
460 (%cursor-ref location))
462 (defmethod unreference-foreign ((class (eql (find-class 'cursor))) location)
463 (declare (ignore class))
464 (%cursor-unref location))
469 (defbinding pixmap-new (width height depth &key window) pixmap
473 (window (or null window)))
475 (defbinding %pixmap-colormap-create-from-xpm () pixmap
476 (window (or null window))
477 (colormap (or null colormap))
479 (color (or null color))
482 (defbinding %pixmap-colormap-create-from-xpm-d () pixmap
483 (window (or null window))
484 (colormap (or null colormap))
486 (color (or null color))
487 (data (vector string)))
489 (defun pixmap-create (source &key color window colormap)
491 (if (not (or window colormap))
494 (multiple-value-bind (pixmap mask)
496 ((or string pathname)
497 (%pixmap-colormap-create-from-xpm
498 window colormap color (namestring (truename source))))
500 (%pixmap-colormap-create-from-xpm-d window colormap color source)))
501 ;; (unreference-instance pixmap)
502 ;; (unreference-instance mask)
503 (values pixmap mask))))
509 (defun %scale-value (value)
512 (float (truncate (* value 65535)))))
514 (defmethod initialize-instance ((color color) &rest initargs
516 (declare (ignore initargs))
518 (with-slots ((%red red) (%green green) (%blue blue)) color
520 %red (%scale-value red)
521 %green (%scale-value green)
522 %blue (%scale-value blue))))
524 (defun ensure-color (color)
530 'color :red (svref color 0) :green (svref color 1)
531 :blue (svref color 2)))))
537 (defbinding drawable-get-size () nil
542 (defbinding (drawable-width "gdk_drawable_get_size") () nil
547 (defbinding (drawable-height "gdk_drawable_get_size") () nil
552 ;; (defbinding drawable-get-clip-region () region
553 ;; (drawable drawable))
555 ;; (defbinding drawable-get-visible-region () region
556 ;; (drawable drawable))
558 (defbinding draw-point () nil
559 (drawable drawable) (gc gc)
562 (defbinding %draw-points () nil
563 (drawable drawable) (gc gc)
567 ;; (defun draw-points (drawable gc &rest points)
571 (defbinding draw-line () nil
572 (drawable drawable) (gc gc)
576 ;; (defbinding draw-lines (drawable gc &rest points) nil
577 ;; (drawable drawable) (gc gc)
578 ;; (points (vector point))
579 ;; ((length points) int))
581 (defbinding draw-pixbuf
582 (drawable gc pixbuf src-x src-y dest-x dest-y &optional
583 width height (dither :none) (x-dither 0) (y-dither 0)) nil
584 (drawable drawable) (gc (or null gc))
586 (src-x int) (src-y int)
587 (dest-x int) (dest-y int)
588 ((or width -1) int) ((or height -1) int)
590 (x-dither int) (y-dither int))
592 ;; (defbinding draw-segments (drawable gc &rest points) nil
593 ;; (drawable drawable) (gc gc)
594 ;; (segments (vector segments))
595 ;; ((length segments) int))
597 (defbinding draw-rectangle () nil
598 (drawable drawable) (gc gc)
601 (width int) (height int))
603 (defbinding draw-arc () nil
604 (drawable drawable) (gc gc)
607 (width int) (height int)
608 (angle1 int) (angle2 int))
610 ;; (defbinding draw-polygon (drawable gc &rest points) nil
611 ;; (drawable drawable) (gc gc)
612 ;; (points (vector point))
613 ;; ((length points) int))
615 ;; (defbinding draw-trapezoid (drawable gc &rest points) nil
616 ;; (drawable drawable) (gc gc)
617 ;; (points (vector point))
618 ;; ((length points) int))
620 ;; (defbinding %draw-layout-line () nil
621 ;; (drawable drawable) (gc gc)
624 ;; (line pango:layout-line))
626 ;; (defbinding %draw-layout-line-with-colors () nil
627 ;; (drawable drawable) (gc gc)
630 ;; (line pango:layout-line)
631 ;; (foreground (or null color))
632 ;; (background (or null color)))
634 ;; (defun draw-layout-line (drawable gc font x y line &optional foreground background)
635 ;; (if (or foreground background)
636 ;; (%draw-layout-line-with-colors drawable gc font x y line foreground background)
637 ;; (%draw-layout-line drawable gc font x y line)))
639 (defbinding %draw-layout () nil
640 (drawable drawable) (gc gc)
643 (layout pango:layout))
645 (defbinding %draw-layout-with-colors () nil
646 (drawable drawable) (gc gc)
649 (layout pango:layout)
650 (foreground (or null color))
651 (background (or null color)))
653 (defun draw-layout (drawable gc font x y layout &optional foreground background)
654 (if (or foreground background)
655 (%draw-layout-with-colors drawable gc font x y layout foreground background)
656 (%draw-layout drawable gc font x y layout)))
658 (defbinding draw-drawable
659 (drawable gc src src-x src-y dest-x dest-y &optional width height) nil
660 (drawable drawable) (gc gc)
662 (src-x int) (src-y int)
663 (dest-x int) (dest-y int)
664 ((or width -1) int) ((or height -1) int))
666 (defbinding draw-image
667 (drawable gc image src-x src-y dest-x dest-y &optional width height) nil
668 (drawable drawable) (gc gc)
670 (src-x int) (src-y int)
671 (dest-x int) (dest-y int)
672 ((or width -1) int) ((or height -1) int))
674 (defbinding drawable-get-image () image
677 (width int) (height int))
679 (defbinding drawable-copy-to-image
680 (drawable src-x src-y width height &optional image dest-x dest-y) image
682 (image (or null image))
683 (src-x int) (src-y int)
684 ((if image dest-x 0) int)
685 ((if image dest-y 0) int)
686 (width int) (height int))
691 (defbinding keyval-name () string
692 (keyval unsigned-int))
694 (defbinding keyval-from-name () unsigned-int
697 (defbinding keyval-to-upper () unsigned-int
698 (keyval unsigned-int))
700 (defbinding keyval-to-lower () unsigned-int
701 (keyval unsigned-int))
703 (defbinding (keyval-is-upper-p "gdk_keyval_is_upper") () boolean
704 (keyval unsigned-int))
706 (defbinding (keyval-is-lower-p "gdk_keyval_is_lower") () boolean
707 (keyval unsigned-int))