Add gsize types for PPC32 and PPC64 archs
[cl-gtk2.git] / glib / glib.lisp
blobcdd1d1ab1c0d16b2b62c7a41fddbcef13ee5aab4
1 (defpackage :glib
2 (:use :cl :cffi :iter)
3 (:export #:at-init
4 #:gsize
5 #:gssize
6 #:goffset
7 #:*glib-major-version*
8 #:*glib-minor-version*
9 #:*glib-micro-version*
10 #:*glib-binary-age*
11 #:*glib-interface-age*
12 #:g-free
13 #:glist
14 #:gstrv
15 #:g-malloc
16 #:g-strdup
17 #:g-string
18 #:gslist
19 #:g-quark
20 #:+g-priority-high+
21 #:+g-priority-default+
22 #:+g-priority-high-idle+
23 #:+g-priority-default-idle+
24 #:+g-priority-low+
25 #:g-idle-add-full
26 #:g-idle-add
27 #:g-timeout-add-full
28 #:g-source-remove
29 #:at-finalize
30 #:with-g-error
31 #:with-catching-to-g-error
32 #:g-error-condition
33 #:g-error-condition-domain
34 #:g-error-condition-code
35 #:g-error-condition-message
36 #:g-spawn-flags
37 #:push-library-version-features
38 #:foreign-library-minimum-version-mismatch
39 #:require-library-version)
40 (:documentation
41 "Cl-gtk2-glib is wrapper for @a[http://library.gnome.org/devel/glib/]{GLib}."))
43 (in-package :glib)
45 (eval-when (:compile-toplevel :load-toplevel :execute)
46 (defvar *initializers-table* (make-hash-table :test 'equalp))
47 (defvar *initializers* nil)
48 (defun register-initializer (key fn)
49 (unless (gethash key *initializers-table*)
50 (setf (gethash key *initializers-table*) t
51 *initializers* (nconc *initializers* (list fn)))))
52 (defvar *finalizers-table* (make-hash-table :test 'equalp))
53 (defvar *finalizers* nil)
54 (defun register-finalizer (key fn)
55 (unless (gethash key *finalizers-table*)
56 (setf (gethash key *finalizers-table*) t
57 *finalizers* (nconc *finalizers* (list fn))))))
59 (defun run-initializers ()
60 (iter (for fn in *initializers*)
61 (funcall fn)))
63 (defun run-finalizers ()
64 (iter (for fn in *finalizers*)
65 (funcall fn)))
67 #+sbcl
68 (pushnew 'run-initializers sb-ext:*init-hooks*)
69 #+openmcl
70 (pushnew 'run-initializers ccl:*restore-lisp-functions*)
72 #+sbcl
73 (pushnew 'run-finalizers sb-ext:*save-hooks*)
74 #+openmcl
75 (pushnew 'run-finalizers ccl:*save-exit-functions*)
77 (defmacro at-init ((&rest keys) &body body)
79 @arg[keys]{list of expression}
80 @arg[body]{the code}
81 Runs the code normally but also schedules the code to be run at image load time.
82 It is used to reinitialize the libraries when the dumped image is loaded. (Works only on SBCL for now).
84 At-init form may be called multiple times. The same code from should not be run multiple times at initialization time (in best case, this will only slow down initialization, in worst case, the code may crash). To ensure this, every @code{at-init} expression is added to hash-table with the @code{body} and @code{keys} as a composite key. This ensures that the same code is only executed once (once on the same set of parameters).
86 Example:
87 @begin{pre}
88 \(defmethod initialize-instance :after ((class gobject-class) &key &allow-other-keys)
89 (register-object-type (gobject-class-g-type-name class) (class-name class))
90 (at-init (class) (initialize-gobject-class-g-type class)))
91 @end{pre}
93 In this example, for every @code{class}, @code{(initialize-gobject-class-g-type class)} will be called only once.
95 `(progn (register-initializer (list ,@keys ',body) (lambda () ,@body))
96 ,@body))
98 (defmacro at-finalize ((&rest keys) &body body)
99 `(register-finalizer (list ,@keys ',body) (lambda () ,@body)))
101 (at-init ()
102 (eval-when (:compile-toplevel :load-toplevel :execute)
103 (define-foreign-library glib
104 (:unix (:or "libglib-2.0.so.0" "libglib-2.0.so"))
105 (:windows "libglib-2.0-0.dll")
106 (t (:default "libglib-2.0"))))
107 (eval-when (:compile-toplevel :load-toplevel :execute)
108 (define-foreign-library gthread
109 (:unix (:or "libgthread-2.0.so.0" "libgthread-2.0.so"))
110 (:windows "libgthread-2.0-0.dll")
111 (t "libgthread-2.0")))
113 (use-foreign-library glib)
114 (use-foreign-library gthread))
116 (defmacro push-library-version-features (library-name major-version-var minor-version-var &body versions)
117 `(eval-when (:load-toplevel :execute)
118 ,@(iter (for (major minor) on versions by #'cddr)
119 (collect
120 `(when (or (and (= ,major-version-var ,major) (>= ,minor-version-var ,minor))
121 (> ,major-version-var ,major))
122 (pushnew ,(intern (format nil "~A-~A.~A" (string library-name) major minor) (find-package :keyword)) *features*))))))
124 (define-condition foreign-library-minimum-version-mismatch (error)
125 ((library :initarg :library :reader .library)
126 (minimum-version :initarg :minimum-version :reader .minimum-version)
127 (actual-version :initarg :actual-version :reader .actual-version))
128 (:report (lambda (c s)
129 (format s "Library ~A has too old version: it is ~A but required to be at least ~A"
130 (.library c)
131 (.actual-version c)
132 (.minimum-version c)))))
134 (defun require-library-version (library min-major-version min-minor-version major-version minor-version)
135 (unless (or (> major-version min-major-version)
136 (and (= major-version min-major-version)
137 (>= minor-version min-minor-version)))
138 (restart-case
139 (error 'foreign-library-minimum-version-mismatch
140 :library library
141 :minimum-version (format nil "~A.~A" min-major-version min-minor-version)
142 :actual-version (format nil "~A.~A" major-version minor-version))
143 (ignore () :report "Ignore version requirement" nil))))
146 ;; Glib Fundamentals
150 ;; Fundamentals - Basic types
154 ;; TODO: not sure about these: for amd64 they are ok
155 (eval-when (:compile-toplevel :load-toplevel :execute)
156 (cond
157 ((cffi-features:cffi-feature-p :x86-64) (defctype gsize :uint64))
158 ((cffi-features:cffi-feature-p :x86) (defctype gsize :ulong))
159 ((cffi-features:cffi-feature-p :ppc32) (defctype gsize :uint32))
160 ((cffi-features:cffi-feature-p :ppc64) (defctype gsize :uint64))
161 (t (error "Can not define 'gsize', unknown CPU architecture (known are x86 and x86-64)"))))
163 (defctype gssize :long)
165 (defctype goffset :uint64)
169 ;; Fundamentals - Version information
172 (defcvar (*glib-major-version* "glib_major_version" :read-only t :library glib) :uint)
173 (defcvar (*glib-minor-version* "glib_minor_version" :read-only t :library glib) :uint)
174 (defcvar (*glib-micro-version* "glib_micro_version" :read-only t :library glib) :uint)
175 (defcvar (*glib-binary-age* "glib_binary_age" :read-only t :library glib) :uint)
176 (defcvar (*glib-interface-age* "glib_interface_age" :read-only t :library glib) :uint)
178 (push-library-version-features glib *glib-major-version* *glib-micro-version*
183 2 10
184 2 12
185 2 14
186 2 16
187 2 18
188 2 20
189 2 22)
191 (require-library-version "Glib" 2 20 *glib-major-version* *glib-minor-version*)
194 ;; Omitted:
195 ;; Limits of Basic Types, Standard Macros, Type Conversion Macros, Byte Order Macros,
196 ;; Numerical Definitions, Miscellaneous Macros, Atomic operations
199 ;; Core Application Support - The Main Event Loop
201 (defcstruct g-main-loop)
202 (defcstruct g-main-context)
203 (defcstruct g-source)
204 (defcstruct g-source-funcs
205 (prepare :pointer)
206 (check :pointer)
207 (dispatch :pointer)
208 (finalize :pointer)
209 (closure-callback :pointer)
210 (closure-marshal :pointer))
211 (defcstruct g-source-callback-funcs
212 (ref :pointer)
213 (unref :pointer)
214 (get :pointer))
215 (defcstruct g-cond)
216 (defcstruct g-mutex)
218 (defcstruct g-poll-fd
219 (fd :int) ;; TODO: #if defined (G_OS_WIN32) && GLIB_SIZEOF_VOID_P == 8
220 (events :ushort)
221 (revent :ushort))
223 (defcstruct g-time-val
224 (seconds :long)
225 (microseconds :long))
227 (defcstruct g-thread)
229 (defcfun (g-main-loop-new "g_main_loop_new" :library glib) (:pointer g-main-loop)
230 (context (:pointer g-main-context))
231 (is-running :boolean))
233 (defcfun (g-main-loop-ref "g_main_loop_ref" :library glib) (:pointer g-main-loop)
234 (loop (:pointer g-main-loop)))
236 (defcfun (g-main-loop-unref "g_main_loop_unref" :library glib) (:pointer g-main-loop)
237 (loop (:pointer g-main-loop)))
239 (defcfun (g-main-loop-run "g_main_loop_run" :library glib) :void
240 (loop (:pointer g-main-loop)))
242 (defcfun (g-main-loop-quit "g_main_loop_quit" :library glib) :void
243 (loop (:pointer g-main-loop)))
245 (defcfun (g-main-loop-is-running "g_main_loop_is_running" :library glib) :boolean
246 (loop (:pointer g-main-loop)))
248 (defcfun (g-main-loop-get-context "g_main_loop_get_context" :library glib) (:pointer g-main-context)
249 (loop (:pointer g-main-loop)))
251 (defconstant +g-priority-high+ -100 "Use this for high priority event sources. It is not used within GLib or GTK+.")
252 (defconstant +g-priority-default+ 0 "Use this for default priority event sources. In GLib this priority is used when adding timeout functions with g_timeout_add(). In GDK this priority is used for events from the X server.")
253 (defconstant +g-priority-high-idle+ 100 "Use this for high priority idle functions. GTK+ uses @variable{+g-priority-high-idle+} + 10 for resizing operations, and @variable{+g-priority-high-idle+} + 20 for redrawing operations. (This is done to ensure that any pending resizes are processed before any pending redraws, so that widgets are not redrawn twice unnecessarily.)")
254 (defconstant +g-priority-default-idle+ 200 "Use this for default priority idle functions. In GLib this priority is used when adding idle functions with g_idle_add().")
255 (defconstant +g-priority-low+ 300 "Use this for very low priority background tasks. It is not used within GLib or GTK+.")
257 (defcfun (g-main-context-new "g_main_context_new" :library glib) (:pointer g-main-context))
259 (defcfun (g-main-context-ref "g_main_context_ref" :library glib) (:pointer g-main-context)
260 (context (:pointer g-main-context)))
262 (defcfun (g-main-context-unref "g_main_context_unref" :library glib) (:pointer g-main-context)
263 (context (:pointer g-main-context)))
265 (defcfun (g-main-context-default "g_main_context_default" :library glib) (:pointer g-main-context))
267 (defcfun (g-main-context-iteration "g_main_context_iteration" :library glib) :boolean
268 (context (:pointer g-main-context))
269 (may-block :boolean))
271 (defcfun (g-main-context-pending "g_main_context_pending" :library glib) :boolean
272 (context (:pointer g-main-context)))
274 (defcfun (g-main-context-find-source-by-id "g_main_context_find_source_by_id" :library glib) (:pointer g-source)
275 (context (:pointer g-main-context))
276 (source-id :uint))
278 (defcfun (g-main-context-find-source-by-user-data "g_main_context_find_source_by_user_data" :library glib) (:pointer g-source)
279 (context (:pointer g-main-context))
280 (user-data :pointer))
282 (defcfun (g-main-context-find-source-by-funcs-user-data "g_main_context_find_source_by_funcs_user_data" :library glib) (:pointer g-source)
283 (context (:pointer g-main-context))
284 (funcs (:pointer g-source-funcs))
285 (user-data :pointer))
287 (defcfun (g-main-context-wakeup "g_main_context_wakeup" :library glib) :void
288 (context (:pointer g-main-context)))
290 (defcfun (g-main-context-acquire "g_main_context_acquire" :library glib) :boolean
291 (context (:pointer g-main-context)))
293 (defcfun (g-main-context-release "g_main_context_release" :library glib) :void
294 (context (:pointer g-main-context)))
296 (defcfun (g-main-context-is-owner "g_main_context_is_owner" :library glib) :boolean
297 (context (:pointer g-main-context)))
299 (defcfun (g-main-context-wait "g_main_context_wait" :library glib) :boolean
300 (context (:pointer g-main-context))
301 (cond (:pointer g-cond))
302 (mutex (:pointer g-mutex)))
304 (defcfun (g_main_context_prepare "g_main_context_prepare" :library glib) :boolean
305 (context (:pointer g-main-context))
306 (priority-ret (:pointer :int)))
308 (defcfun (g_main_context_query "g_main_context_query" :library glib) :int
309 (context (:pointer g-main-context))
310 (max-priority :int)
311 (timeout-ret (:pointer :int))
312 (fds-ret (:pointer g-poll-fd))
313 (n-dfs :int))
315 (defcfun (g-main-context-check "g_main_context_check" :library glib) :int
316 (context (:pointer g-main-context))
317 (max-priority :int)
318 (fds (:pointer g-poll-fd))
319 (n-fds :int))
321 (defcfun (g-main-context-dispatch "g_main_context_dispatch" :library glib) :void
322 (context (:pointer g-main-context)))
324 (defcfun (g-main-context-set-poll-func "g_main_context_set_poll_func" :library glib) :void
325 (context (:pointer g-main-context))
326 (func :pointer))
328 (defcfun (g-main-context-get-poll-func "g_main_context_get_poll_func" :library glib) :pointer
329 (context (:pointer g-main-context)))
331 (defcfun (g-main-context-add-poll "g_main_context_add_poll" :library glib) :void
332 (context (:pointer g-main-context))
333 (fd (:pointer g-poll-fd))
334 (priority :int))
336 (defcfun (g-main-context-remove-poll "g_main_context_remove_poll" :library glib) :void
337 (context (:pointer g-main-context))
338 (fd (:pointer g-poll-fd)))
340 (defcfun (g-main-depth "g_main_depth" :library glib) :int)
342 (defcfun (g-main-current-source "g_main_current_source" :library glib) (:pointer g-source))
344 (defcfun (g-timeout-source-new "g_timeout_source_new" :library glib) (:pointer g-source)
345 (interval-milliseconds :int))
347 (defcfun (g-timeout-source-new-seconds "g_timeout_source_new_seconds" :library glib) (:pointer g-source)
348 (interval-seconds :int))
350 (defcfun (g-timeout-add "g_timeout_add" :library glib) :uint
351 (interval-milliseconds :uint)
352 (function :pointer)
353 (data :pointer))
355 (defcfun (g-timeout-add-full "g_timeout_add_full" :library glib) :uint
356 (priority :int)
357 (interval-milliseconds :uint)
358 (function :pointer)
359 (data :pointer)
360 (destroy-notify :pointer))
362 (defcfun (g-timeout-add-seconds "g_timeout_add_seconds" :library glib) :uint
363 (interval-seconds :uint)
364 (function :pointer)
365 (data :pointer))
367 (defcfun (g-timeout-add-seconds-full "g_timeout_add_seconds_full" :library glib) :uint
368 (priority :int)
369 (interval-seconds :uint)
370 (function :pointer)
371 (data :pointer)
372 (destroy-notify :pointer))
374 (defcfun (g-idle-source-new "g_idle_source_new" :library glib) (:pointer g-source))
376 (defcfun (g-idle-add "g_idle_add" :library glib) :uint
377 (function :pointer)
378 (data :pointer))
380 (defcfun (g-idle-add-full "g_idle_add_full" :library glib) :uint
381 "A low-level function for adding callbacks to be called from main loop. Wrapper around g_idle_add_full.
382 Adds a function to be called whenever there are no higher priority events pending. If the function returns FALSE it is automatically removed from the list of event sources and will not be called again.
383 @arg[priority]{an integer specifying the priority. See @variable{+g-priority-default+}, @variable{+g-priority-default-idle+}, @variable{+g-priority-high+}, @variable{+g-priority-high-idle+}, @variable{+g-priority-low+}.}
384 @arg[function]{pointer to callback that will be called. Callback should accept a single pointer argument and return a boolean FALSE if it should be removed}
385 @arg[data]{pointer that will be passed to callback function}
386 @arg[notify]{function that will be called when callback is no more needed. It will receive the @code{data} argument}"
387 (priority :uint)
388 (function :pointer)
389 (data :pointer)
390 (notify :pointer))
392 (defcfun (g-idle-remove-by-data "g_idle_remove_by_data" :library glib) :boolean
393 (data :pointer))
395 ;(defctype g-pid :int) ;;TODO: might work on amd64 linux, but on others
397 ;; Omitted GPid, g_child_add_watch, g_child_add_watch_full
399 (defcfun (g-source-new "g_source_new" :library glib) (:pointer g-source)
400 (source-funcs (:pointer g-source-funcs))
401 (struct-size :uint))
403 (defcfun (g-source-ref "g_source_ref" :library glib) (:pointer g-source)
404 (source (:pointer g-source)))
406 (defcfun (g-source-unref "g_source_unref" :library glib) :void
407 (source (:pointer g-source)))
409 (defcfun (g-source-set-funcs "g_source_set_funcs" :library glib) :void
410 (source (:pointer g-source))
411 (funcs (:pointer g-source-funcs)))
413 (defcfun (g-source-attach "g_source_attach" :library glib) :uint
414 (source (:pointer g-source))
415 (context (:pointer g-main-context)))
417 (defcfun (g-source-destroy "g_source_destroy" :library glib) :void
418 (source (:pointer g-source)))
420 (defcfun (g-source-is-destroyed "g_source_is_destroyed" :library glib) :boolean
421 (source (:pointer g-source)))
423 (defcfun (g-source-set-priority "g_source_set_priority" :library glib) :void
424 (source (:pointer g-source))
425 (priority :int))
427 (defcfun (g-source-get-priority "g_source_get_priority" :library glib) :int
428 (source (:pointer g-source)))
430 (defcfun (g-source-set-can-recurse "g_source_set_can_recurse" :library glib) :void
431 (source (:pointer g-source))
432 (can-recurse :boolean))
434 (defcfun (g-source-get-can-recurse "g_source_get_can_recurse" :library glib) :boolean
435 (source (:pointer g-source)))
437 (defcfun (g-source-get-id "g_source_get_id" :library glib) :uint
438 (source (:pointer g-source)))
440 (defcfun (g-source-get-context "g_source_get_context" :library glib) (:pointer g-main-context)
441 (source (:pointer g-source)))
443 (defcfun (g-source-set-callback "g_source_set_callback" :library glib) :void
444 (source (:pointer g-source))
445 (func :pointer)
446 (data :pointer)
447 (notify :pointer))
449 (defcfun (g-source-add-poll "g_source_add_poll" :library glib) :void
450 (source (:pointer g-source))
451 (fd (:pointer g-poll-fd)))
453 (defcfun (g-source-remove-poll "g_source_remove_poll" :library glib) :void
454 (source (:pointer g-source))
455 (fd (:pointer g-poll-fd)))
457 (defcfun (g-source-get-current-time "g_source_get_current_time" :library glib) :void
458 (source (:pointer g-source))
459 (timeval-ret (:pointer g-time-val)))
461 (defcfun (g-source-remove "g_source_remove" :library glib) :boolean
462 (id :uint))
464 (defcfun (g-source-remove-by-funcs-user-data "g_source_remove_by_funcs_user_data" :library glib) :boolean
465 (funcs (:pointer g-source-funcs))
466 (data :pointer))
468 (defcfun (g-source-remove-by-user-data "g_source_remove_by_user_data" :library glib) :boolean
469 (data :pointer))
472 ;; Core Application Support - Threads
475 (defcenum g-thread-error
476 :g-thread-error-again)
478 ;omitted: struct GThreadFunctions
480 (defcfun (g-thread-init "g_thread_init") :void
481 (vtable :pointer))
483 (defcfun g-thread-get-initialized :boolean)
485 (at-init ()
486 (unless (g-thread-get-initialized)
487 (g-thread-init (null-pointer))))
489 (defcenum g-thread-priority
490 :g-thread-priority-low
491 :g-thread-priority-normal
492 :g-thread-priority-hight
493 :g-thread-priority-urgent)
495 ;omitted: g_thread_create, g_thread_create_full, g_thread_yield, g_thread_exit, g_thread_foreach
497 (defcfun (g-thread-self "g_thread_self" :library glib) (:pointer g-thread))
499 (defcfun (g-thread-join "g_thread_join" :library glib) :pointer
500 (thread (:pointer g-thread)))
502 (defcfun (g-thread-priority "g_thread_set_priority" :library glib) :void
503 (thread (:pointer g-thread))
504 (priority g-thread-priority))
506 ;;;; TODO: Commented g_mutex_*, g_cond* because they are not functions, but called through dispatch table
508 ;; (defcfun (g-mutex-new "g_mutex_new" :library glib) (:pointer g-mutex))
510 ;; (defcfun (g-mutex-lock "g_mutex_lock" :library glib) :void
511 ;; (mutex (:pointer g-mutex)))
513 ;; (defcfun (g-mutex-try-lock "g_mutex_trylock" :library glib) :boolean
514 ;; (mutex (:pointer g-mutex)))
516 ;; (defcfun (g-mutex-free "g_mutex_free" :library glib) :void
517 ;; (mutex (:pointer g-mutex)))
519 ;omitted: GStaticMutex, GStaticRWLock stuff
521 ;; (defcfun (g-cond-new "g_cond_new" :library glib) (:pointer g-cond))
523 ;; (defcfun (g-cond-signal "g_cond_signal" :library glib) :void
524 ;; (cond (:pointer g-cond)))
526 ;; (defcfun (g-cond-broadcast "g_cond_broadcast" :library glib) :void
527 ;; (cond (:pointer g-cond)))
529 ;; (defcfun (g-cond-wait "g_cond_wait" :library glib) :void
530 ;; (cond (:pointer g-cond))
531 ;; (mutex (:pointer g-mutex)))
533 ;; (defcfun (g-cond-timed-wait "g_cond_timed_wait" :library glib) :boolean
534 ;; (cond (:pointer g-cond))
535 ;; (mutex (:pointer g-mutex))
536 ;; (abs-time (:pointer g-time-val)))
538 ;; (defcfun (g-cond-free "g_cond_free" :library glib) :void
539 ;; (cond (:pointer g-cond)))
541 ;omitted: GPrivate, GOnce stuff
543 ;omitted: Thread pools, Asynchronous queues, Dynamic Loading of Modules,
544 ; Memory Allocation, IO Channels, Error Reporting, Message Output and Debugging Functions, Message Logging
546 (defcfun g-free :void
547 "@arg[ptr]{pointer previously obtained with @fun{g-malloc} or with g_malloc C function}
548 Frees the pointer by calling g_free on it."
549 (ptr :pointer))
551 (defcfun (g-malloc "g_malloc0") :pointer
552 "@arg[n-bytes]{an integer}
553 @return{pointer to beginning of allocated memory}
554 Allocates the specified number of bytes in memory. Calls g_malloc.
555 @see{g-free}"
556 (n-bytes gsize))
558 (defcfun g-strdup :pointer
559 "@arg[str]{a @class{string}}
560 @return{foreign pointer to new string}
561 Allocates a new string that is equal to @code{str}. Use @fun{g-free} to free it."
562 (str (:string :free-to-foreign t)))
564 ;omitted all GLib Utilites
566 (defbitfield g-spawn-flags
567 :leave-descriptors-open :do-not-reap-child :search-path :stdout-to-dev-null :stderr-to-dev-null
568 :child-inherits-stdin :file-and-argv-zero)
570 ;TODO: omitted Date and Time Functions