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.10 2004-10-31 11:51:08 espen Exp $
25 (defbinding (gdk-init "gdk_parse_args") () nil
26 "Initializes the library without opening the display."
33 (defbinding %display-manager-get () display-manager)
35 (defbinding (display-set-default "gdk_display_manager_set_default_display")
37 ((%display-manager-get) display-manager)
40 (defbinding display-get-default () display)
42 (defbinding %display-open () display
43 (display-name (or null string)))
45 (defun display-open (&optional display-name)
46 (let ((display (%display-open display-name)))
47 (unless (display-get-default)
48 (display-set-default display))
51 (defbinding (display-connection-number "clg_gdk_connection_number")
52 (&optional (display (display-get-default))) int
58 (defbinding (events-pending-p "gdk_events_pending") () boolean)
60 (defbinding event-get () event)
62 (defbinding event-peek () event)
64 (defbinding event-get-graphics-expose () event
67 (defbinding event-put () event
70 ;(defbinding event-handler-set () ...)
72 (defbinding set-show-events () nil
73 (show-events boolean))
77 (defbinding set-use-xshm () nil
80 (defbinding get-show-events () boolean)
82 (defbinding get-use-xshm () boolean)
84 (defbinding get-display () string)
86 ; (defbinding time-get () (unsigned 32))
88 ; (defbinding timer-get () (unsigned 32))
90 ; (defbinding timer-set () nil
91 ; (milliseconds (unsigned 32)))
93 ; (defbinding timer-enable () nil)
95 ; (defbinding timer-disable () nil)
99 (defbinding pointer-grab () int
101 (owner-events boolean)
102 (event-mask event-mask)
103 (confine-to (or null window))
104 (cursor (or null cursor))
105 (time (unsigned 32)))
107 (defbinding pointer-ungrab () nil
108 (time (unsigned 32)))
110 (defbinding keyboard-grab () int
112 (owner-events boolean)
113 (time (unsigned 32)))
115 (defbinding keyboard-ungrab () nil
116 (time (unsigned 32)))
118 (defbinding (pointer-is-grabbed-p "gdk_pointer_is_grabbed") () boolean)
120 (defbinding screen-width () int)
121 (defbinding screen-height () int)
123 (defbinding screen-width-mm () int)
124 (defbinding screen-height-mm () int)
126 (defbinding flush () nil)
127 (defbinding beep () nil)
133 (defbinding visual-get-best-depth () int)
135 (defbinding visual-get-best-type () visual-type)
137 (defbinding visual-get-system () visual)
140 (defbinding (%visual-get-best-with-nothing "gdk_visual_get_best") () visual)
142 (defbinding %visual-get-best-with-depth () visual
145 (defbinding %visual-get-best-with-type () visual
148 (defbinding %visual-get-best-with-both () visual
152 (defun visual-get-best (&key depth type)
154 ((and depth type) (%visual-get-best-with-both depth type))
155 (depth (%visual-get-best-with-depth depth))
156 (type (%visual-get-best-with-type type))
157 (t (%visual-get-best-with-nothing))))
159 ;(defbinding query-depths ..)
161 ;(defbinding query-visual-types ..)
163 (defbinding list-visuals () (glist visual))
168 ; (defbinding window-new ... )
170 (defbinding window-destroy () nil
174 ; (defbinding window-at-pointer () window
179 (defbinding window-show () nil
182 (defbinding window-hide () nil
185 (defbinding window-withdraw () nil
188 (defbinding window-move () nil
193 (defbinding window-resize () nil
198 (defbinding window-move-resize () nil
205 (defbinding window-reparent () nil
211 (defbinding window-clear () nil
215 '(window-clear-area-no-e window-clear-area-e))
217 (defbinding (window-clear-area-no-e "gdk_window_clear_area") () nil
219 (x int) (y int) (width int) (height int))
221 (defbinding window-clear-area-e () nil
223 (x int) (y int) (width int) (height int))
225 (defun window-clear-area (window x y width height &optional expose)
227 (window-clear-area-e window x y width height)
228 (window-clear-area-no-e window x y width height)))
230 ; (defbinding window-copy-area () nil
235 ; (source-window window)
241 (defbinding window-raise () nil
244 (defbinding window-lower () nil
247 ; (defbinding window-set-user-data () nil
249 (defbinding window-set-override-redirect () nil
251 (override-redirect boolean))
253 ; (defbinding window-add-filter () nil
255 ; (defbinding window-remove-filter () nil
257 (defbinding window-shape-combine-mask () nil
263 (defbinding window-set-child-shapes () nil
266 (defbinding window-merge-child-shapes () nil
269 (defbinding (window-is-visible-p "gdk_window_is_visible") () boolean
272 (defbinding (window-is-viewable-p "gdk_window_is_viewable") () boolean
275 (defbinding window-set-static-gravities () boolean
277 (use-static boolean))
279 ; (defbinding add-client-message-filter ...
286 (defbinding drag-status () nil
287 (context drag-context)
289 (time (unsigned 32)))
294 (defbinding window-set-cursor () nil
298 (defbinding window-get-pointer () window
302 (mask modifier-type :out))
304 (defbinding %get-default-root-window () window)
306 (defun get-root-window (&optional display)
308 (error "Not implemented")
309 (%get-default-root-window)))
314 (defbinding rgb-init () nil)
321 (deftype-method alien-ref cursor (type-spec)
322 (declare (ignore type-spec))
325 (deftype-method alien-unref cursor (type-spec)
326 (declare (ignore type-spec))
330 (defbinding cursor-new () cursor
331 (cursor-type cursor-type))
333 (defbinding cursor-new-from-pixmap () cursor
340 (defbinding %cursor-ref () pointer
341 (cursor (or cursor pointer)))
343 (defbinding %cursor-unref () nil
344 (cursor (or cursor pointer)))
350 (defbinding pixmap-new (width height depth &key window) pixmap
354 (window (or null window)))
356 (defbinding %pixmap-colormap-create-from-xpm () pixmap
357 (window (or null window))
358 (colormap (or null colormap))
360 (color (or null color))
363 (defbinding %pixmap-colormap-create-from-xpm-d () pixmap
364 (window (or null window))
365 (colormap (or null colormap))
367 (color (or null color))
368 (data (vector string)))
370 (defun pixmap-create (source &key color window colormap)
372 (if (not (or window colormap))
375 (multiple-value-bind (pixmap mask)
377 ((or string pathname)
378 (%pixmap-colormap-create-from-xpm
379 window colormap color (namestring (truename source))))
381 (%pixmap-colormap-create-from-xpm-d window colormap color source)))
382 ;; (unreference-instance pixmap)
383 ;; (unreference-instance mask)
384 (values pixmap mask))))
390 (defun %scale-value (value)
393 (float (truncate (* value 65535)))))
395 (defmethod initialize-instance ((color color) &rest initargs
397 (declare (ignore initargs))
399 (with-slots ((%red red) (%green green) (%blue blue)) color
401 %red (%scale-value red)
402 %green (%scale-value green)
403 %blue (%scale-value blue))))
405 (defun ensure-color (color)
411 'color :red (svref color 0) :green (svref color 1)
412 :blue (svref color 2)))))
416 ;;; Drawing functions
418 (defbinding draw-rectangle () nil
419 (drawable (or window pixmap bitmap))
420 (gc gc) (filled boolean)
421 (x int) (y int) (width int) (height int))
426 (defbinding keyval-name () string
427 (keyval unsigned-int))
429 (defbinding keyval-from-name () unsigned-int
432 (defbinding keyval-to-upper () unsigned-int
433 (keyval unsigned-int))
435 (defbinding keyval-to-lower ()unsigned-int
436 (keyval unsigned-int))
438 (defbinding (keyval-is-upper-p "gdk_keyval_is_upper") () boolean
439 (keyval unsigned-int))
441 (defbinding (keyval-is-lower-p "gdk_keyval_is_lower") () boolean
442 (keyval unsigned-int))