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.11 2004-11-06 21:39:58 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-new ... )
171 (defbinding window-destroy () nil
175 ; (defbinding window-at-pointer () window
180 (defbinding window-show () nil
183 (defbinding window-hide () nil
186 (defbinding window-withdraw () nil
189 (defbinding window-move () nil
194 (defbinding window-resize () nil
199 (defbinding window-move-resize () nil
206 (defbinding window-reparent () nil
212 (defbinding window-clear () nil
216 '(window-clear-area-no-e window-clear-area-e))
218 (defbinding (window-clear-area-no-e "gdk_window_clear_area") () nil
220 (x int) (y int) (width int) (height int))
222 (defbinding window-clear-area-e () nil
224 (x int) (y int) (width int) (height int))
226 (defun window-clear-area (window x y width height &optional expose)
228 (window-clear-area-e window x y width height)
229 (window-clear-area-no-e window x y width height)))
231 ; (defbinding window-copy-area () nil
236 ; (source-window window)
242 (defbinding window-raise () nil
245 (defbinding window-lower () nil
248 ; (defbinding window-set-user-data () nil
250 (defbinding window-set-override-redirect () nil
252 (override-redirect boolean))
254 ; (defbinding window-add-filter () nil
256 ; (defbinding window-remove-filter () nil
258 (defbinding window-shape-combine-mask () nil
264 (defbinding window-set-child-shapes () nil
267 (defbinding window-merge-child-shapes () nil
270 (defbinding (window-is-visible-p "gdk_window_is_visible") () boolean
273 (defbinding (window-is-viewable-p "gdk_window_is_viewable") () boolean
276 (defbinding window-set-static-gravities () boolean
278 (use-static boolean))
280 ; (defbinding add-client-message-filter ...
287 (defbinding drag-status () nil
288 (context drag-context)
290 (time (unsigned 32)))
295 (defbinding window-set-cursor () nil
299 (defbinding window-get-pointer () window
303 (mask modifier-type :out))
305 (defbinding %get-default-root-window () window)
307 (defun get-root-window (&optional display)
309 (error "Not implemented")
310 (%get-default-root-window)))
315 (defbinding rgb-init () nil)
322 (defbinding cursor-new () cursor
323 (cursor-type cursor-type))
325 (defbinding cursor-new-from-pixmap () cursor
332 (defbinding %cursor-ref () pointer
335 (defbinding %cursor-unref () nil
338 (defmethod reference-foreign ((class (eql (find-class 'cursor))) location)
339 (declare (ignore class))
340 (%cursor-ref location))
342 (defmethod unreference-foreign ((class (eql (find-class 'cursor))) location)
343 (declare (ignore class))
344 (%cursor-unref location))
351 (defbinding pixmap-new (width height depth &key window) pixmap
355 (window (or null window)))
357 (defbinding %pixmap-colormap-create-from-xpm () pixmap
358 (window (or null window))
359 (colormap (or null colormap))
361 (color (or null color))
364 (defbinding %pixmap-colormap-create-from-xpm-d () pixmap
365 (window (or null window))
366 (colormap (or null colormap))
368 (color (or null color))
369 (data (vector string)))
371 (defun pixmap-create (source &key color window colormap)
373 (if (not (or window colormap))
376 (multiple-value-bind (pixmap mask)
378 ((or string pathname)
379 (%pixmap-colormap-create-from-xpm
380 window colormap color (namestring (truename source))))
382 (%pixmap-colormap-create-from-xpm-d window colormap color source)))
383 ;; (unreference-instance pixmap)
384 ;; (unreference-instance mask)
385 (values pixmap mask))))
391 (defun %scale-value (value)
394 (float (truncate (* value 65535)))))
396 (defmethod initialize-instance ((color color) &rest initargs
398 (declare (ignore initargs))
400 (with-slots ((%red red) (%green green) (%blue blue)) color
402 %red (%scale-value red)
403 %green (%scale-value green)
404 %blue (%scale-value blue))))
406 (defun ensure-color (color)
412 'color :red (svref color 0) :green (svref color 1)
413 :blue (svref color 2)))))
417 ;;; Drawing functions
419 (defbinding draw-rectangle () nil
420 (drawable (or window pixmap bitmap))
421 (gc gc) (filled boolean)
422 (x int) (y int) (width int) (height int))
427 (defbinding keyval-name () string
428 (keyval unsigned-int))
430 (defbinding keyval-from-name () unsigned-int
433 (defbinding keyval-to-upper () unsigned-int
434 (keyval unsigned-int))
436 (defbinding keyval-to-lower ()unsigned-int
437 (keyval unsigned-int))
439 (defbinding (keyval-is-upper-p "gdk_keyval_is_upper") () boolean
440 (keyval unsigned-int))
442 (defbinding (keyval-is-lower-p "gdk_keyval_is_lower") () boolean
443 (keyval unsigned-int))