Check the libraries' versions requirement and throw compile-time error; add libraries...
[cl-gtk2.git] / glib / glib.lisp
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}."))
42
43 (in-package :glib)
44
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))))))
58
59 (defun run-initializers ()
60   (iter (for fn in *initializers*)
61         (funcall fn)))
62
63 (defun run-finalizers ()
64   (iter (for fn in *finalizers*)
65         (funcall fn)))
66
67 #+sbcl
68 (pushnew 'run-initializers sb-ext:*init-hooks*)
69 #+openmcl
70 (pushnew 'run-initializers ccl:*restore-lisp-functions*)
71
72 #+sbcl
73 (pushnew 'run-finalizers sb-ext:*save-hooks*)
74 #+openmcl
75 (pushnew 'run-finalizers ccl:*save-exit-functions*)
76
77 (defmacro at-init ((&rest keys) &body body)
78   "
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).
83
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).
85
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}
92
93 In this example, for every @code{class}, @code{(initialize-gobject-class-g-type class)} will be called only once.
94 "
95   `(progn (register-initializer (list ,@keys ',body) (lambda () ,@body))
96           ,@body))
97
98 (defmacro at-finalize ((&rest keys) &body body)
99   `(register-finalizer (list ,@keys ',body) (lambda () ,@body)))
100
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")))
112
113   (use-foreign-library glib)
114   (use-foreign-library gthread))
115
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*))))))
123
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)))))
133
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))))
144
145 ;;
146 ;; Glib Fundamentals
147 ;;
148
149 ;;
150 ;; Fundamentals - Basic types
151 ;;
152
153
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     (t (error "Can not define 'gsize', unknown CPU architecture (known are x86 and x86-64)"))))
160
161 (defctype gssize :long)
162
163 (defctype goffset :uint64)
164
165
166 ;;
167 ;; Fundamentals - Version information
168 ;;
169
170 (defcvar (*glib-major-version* "glib_major_version" :read-only t :library glib) :uint)
171 (defcvar (*glib-minor-version* "glib_minor_version" :read-only t :library glib) :uint)
172 (defcvar (*glib-micro-version* "glib_micro_version" :read-only t :library glib) :uint)
173 (defcvar (*glib-binary-age* "glib_binary_age" :read-only t :library glib) :uint)
174 (defcvar (*glib-interface-age* "glib_interface_age" :read-only t :library glib) :uint)
175
176 (push-library-version-features glib *glib-major-version* *glib-micro-version*
177   2 2
178   2 4
179   2 6
180   2 8
181   2 10
182   2 12
183   2 14
184   2 16
185   2 18
186   2 20
187   2 22)
188
189 (require-library-version "Glib" 2 20 *glib-major-version* *glib-minor-version*)
190
191 ;;
192 ;; Omitted:
193 ;; Limits of Basic Types, Standard Macros, Type Conversion Macros, Byte Order Macros, 
194 ;; Numerical Definitions, Miscellaneous Macros, Atomic operations
195 ;;
196
197 ;; Core Application Support - The Main Event Loop
198
199 (defcstruct g-main-loop)
200 (defcstruct g-main-context)
201 (defcstruct g-source)
202 (defcstruct g-source-funcs
203   (prepare :pointer)
204   (check :pointer)
205   (dispatch :pointer)
206   (finalize :pointer)
207   (closure-callback :pointer)
208   (closure-marshal :pointer))
209 (defcstruct g-source-callback-funcs
210   (ref :pointer)
211   (unref :pointer)
212   (get :pointer))
213 (defcstruct g-cond)
214 (defcstruct g-mutex)
215
216 (defcstruct g-poll-fd
217   (fd :int) ;; TODO: #if defined (G_OS_WIN32) && GLIB_SIZEOF_VOID_P == 8
218   (events :ushort)
219   (revent :ushort))
220
221 (defcstruct g-time-val
222   (seconds :long)
223   (microseconds :long))
224
225 (defcstruct g-thread)
226
227 (defcfun (g-main-loop-new "g_main_loop_new" :library glib) (:pointer g-main-loop)
228   (context (:pointer g-main-context))
229   (is-running :boolean))
230
231 (defcfun (g-main-loop-ref "g_main_loop_ref" :library glib) (:pointer g-main-loop)
232   (loop (:pointer g-main-loop)))
233
234 (defcfun (g-main-loop-unref "g_main_loop_unref" :library glib) (:pointer g-main-loop)
235   (loop (:pointer g-main-loop)))
236
237 (defcfun (g-main-loop-run "g_main_loop_run" :library glib) :void
238   (loop (:pointer g-main-loop)))
239
240 (defcfun (g-main-loop-quit "g_main_loop_quit" :library glib) :void
241   (loop (:pointer g-main-loop)))
242
243 (defcfun (g-main-loop-is-running "g_main_loop_is_running" :library glib) :boolean
244   (loop (:pointer g-main-loop)))
245
246 (defcfun (g-main-loop-get-context "g_main_loop_get_context" :library glib) (:pointer g-main-context)
247   (loop (:pointer g-main-loop)))
248
249 (defconstant +g-priority-high+ -100 "Use this for high priority event sources. It is not used within GLib or GTK+.")
250 (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.")
251 (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.)")
252 (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().")
253 (defconstant +g-priority-low+ 300 "Use this for very low priority background tasks. It is not used within GLib or GTK+.")
254
255 (defcfun (g-main-context-new "g_main_context_new" :library glib) (:pointer g-main-context))
256
257 (defcfun (g-main-context-ref "g_main_context_ref" :library glib) (:pointer g-main-context)
258   (context (:pointer g-main-context)))
259
260 (defcfun (g-main-context-unref "g_main_context_unref" :library glib) (:pointer g-main-context)
261   (context (:pointer g-main-context)))
262
263 (defcfun (g-main-context-default "g_main_context_default" :library glib) (:pointer g-main-context))
264
265 (defcfun (g-main-context-iteration "g_main_context_iteration" :library glib) :boolean
266   (context (:pointer g-main-context))
267   (may-block :boolean))
268
269 (defcfun (g-main-context-pending "g_main_context_pending" :library glib) :boolean
270   (context (:pointer g-main-context)))
271
272 (defcfun (g-main-context-find-source-by-id "g_main_context_find_source_by_id" :library glib) (:pointer g-source)
273   (context (:pointer g-main-context))
274   (source-id :uint))
275
276 (defcfun (g-main-context-find-source-by-user-data "g_main_context_find_source_by_user_data" :library glib) (:pointer g-source)
277   (context (:pointer g-main-context))
278   (user-data :pointer))
279
280 (defcfun (g-main-context-find-source-by-funcs-user-data "g_main_context_find_source_by_funcs_user_data" :library glib) (:pointer g-source)
281   (context (:pointer g-main-context))
282   (funcs (:pointer g-source-funcs))
283   (user-data :pointer))
284
285 (defcfun (g-main-context-wakeup "g_main_context_wakeup" :library glib) :void
286   (context (:pointer g-main-context)))
287
288 (defcfun (g-main-context-acquire "g_main_context_acquire" :library glib) :boolean
289   (context (:pointer g-main-context)))
290
291 (defcfun (g-main-context-release "g_main_context_release" :library glib) :void
292   (context (:pointer g-main-context)))
293
294 (defcfun (g-main-context-is-owner "g_main_context_is_owner" :library glib) :boolean
295   (context (:pointer g-main-context)))
296
297 (defcfun (g-main-context-wait "g_main_context_wait" :library glib) :boolean
298   (context (:pointer g-main-context))
299   (cond (:pointer g-cond))
300   (mutex (:pointer g-mutex)))
301
302 (defcfun (g_main_context_prepare "g_main_context_prepare" :library glib) :boolean
303   (context (:pointer g-main-context))
304   (priority-ret (:pointer :int)))
305
306 (defcfun (g_main_context_query "g_main_context_query" :library glib) :int
307   (context (:pointer g-main-context))
308   (max-priority :int)
309   (timeout-ret (:pointer :int))
310   (fds-ret (:pointer g-poll-fd))
311   (n-dfs :int))
312
313 (defcfun (g-main-context-check "g_main_context_check" :library glib) :int
314   (context (:pointer g-main-context))
315   (max-priority :int)
316   (fds (:pointer g-poll-fd))
317   (n-fds :int))
318
319 (defcfun (g-main-context-dispatch "g_main_context_dispatch" :library glib) :void
320   (context (:pointer g-main-context)))
321
322 (defcfun (g-main-context-set-poll-func "g_main_context_set_poll_func" :library glib) :void
323   (context (:pointer g-main-context))
324   (func :pointer))
325
326 (defcfun (g-main-context-get-poll-func "g_main_context_get_poll_func" :library glib) :pointer
327   (context (:pointer g-main-context)))
328
329 (defcfun (g-main-context-add-poll "g_main_context_add_poll" :library glib) :void
330   (context (:pointer g-main-context))
331   (fd (:pointer g-poll-fd))
332   (priority :int))
333
334 (defcfun (g-main-context-remove-poll "g_main_context_remove_poll" :library glib) :void
335   (context (:pointer g-main-context))
336   (fd (:pointer g-poll-fd)))
337
338 (defcfun (g-main-depth "g_main_depth" :library glib) :int)
339
340 (defcfun (g-main-current-source "g_main_current_source" :library glib) (:pointer g-source))
341
342 (defcfun (g-timeout-source-new "g_timeout_source_new" :library glib) (:pointer g-source)
343   (interval-milliseconds :int))
344
345 (defcfun (g-timeout-source-new-seconds "g_timeout_source_new_seconds" :library glib) (:pointer g-source)
346   (interval-seconds :int))
347
348 (defcfun (g-timeout-add "g_timeout_add" :library glib) :uint
349   (interval-milliseconds :uint)
350   (function :pointer)
351   (data :pointer))
352
353 (defcfun (g-timeout-add-full "g_timeout_add_full" :library glib) :uint
354   (priority :int)
355   (interval-milliseconds :uint)
356   (function :pointer)
357   (data :pointer)
358   (destroy-notify :pointer))
359
360 (defcfun (g-timeout-add-seconds "g_timeout_add_seconds" :library glib) :uint
361   (interval-seconds :uint)
362   (function :pointer)
363   (data :pointer))
364
365 (defcfun (g-timeout-add-seconds-full "g_timeout_add_seconds_full" :library glib) :uint
366   (priority :int)
367   (interval-seconds :uint)
368   (function :pointer)
369   (data :pointer)
370   (destroy-notify :pointer))
371
372 (defcfun (g-idle-source-new "g_idle_source_new" :library glib) (:pointer g-source))
373
374 (defcfun (g-idle-add "g_idle_add" :library glib) :uint
375   (function :pointer)
376   (data :pointer))
377
378 (defcfun (g-idle-add-full "g_idle_add_full" :library glib) :uint
379   "A low-level function for adding callbacks to be called from main loop. Wrapper around g_idle_add_full.
380 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.
381 @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+}.}
382 @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}
383 @arg[data]{pointer that will be passed to callback function}
384 @arg[notify]{function that will be called when callback is no more needed. It will receive the @code{data} argument}"
385   (priority :uint)
386   (function :pointer)
387   (data :pointer)
388   (notify :pointer))
389
390 (defcfun (g-idle-remove-by-data "g_idle_remove_by_data" :library glib) :boolean
391   (data :pointer))
392
393 ;(defctype g-pid :int) ;;TODO: might work on amd64 linux, but on others
394
395 ;; Omitted GPid, g_child_add_watch, g_child_add_watch_full
396
397 (defcfun (g-source-new "g_source_new" :library glib) (:pointer g-source)
398   (source-funcs (:pointer g-source-funcs))
399   (struct-size :uint))
400
401 (defcfun (g-source-ref "g_source_ref" :library glib) (:pointer g-source)
402   (source (:pointer g-source)))
403
404 (defcfun (g-source-unref "g_source_unref" :library glib) :void
405   (source (:pointer g-source)))
406
407 (defcfun (g-source-set-funcs "g_source_set_funcs" :library glib) :void
408   (source (:pointer g-source))
409   (funcs (:pointer g-source-funcs)))
410
411 (defcfun (g-source-attach "g_source_attach" :library glib) :uint
412   (source (:pointer g-source))
413   (context (:pointer g-main-context)))
414
415 (defcfun (g-source-destroy "g_source_destroy" :library glib) :void
416   (source (:pointer g-source)))
417
418 (defcfun (g-source-is-destroyed "g_source_is_destroyed" :library glib) :boolean
419   (source (:pointer g-source)))
420
421 (defcfun (g-source-set-priority "g_source_set_priority" :library glib) :void
422   (source (:pointer g-source))
423   (priority :int))
424
425 (defcfun (g-source-get-priority "g_source_get_priority" :library glib) :int
426   (source (:pointer g-source)))
427
428 (defcfun (g-source-set-can-recurse "g_source_set_can_recurse" :library glib) :void
429   (source (:pointer g-source))
430   (can-recurse :boolean))
431
432 (defcfun (g-source-get-can-recurse "g_source_get_can_recurse" :library glib) :boolean
433   (source (:pointer g-source)))
434
435 (defcfun (g-source-get-id "g_source_get_id" :library glib) :uint
436   (source (:pointer g-source)))
437
438 (defcfun (g-source-get-context "g_source_get_context" :library glib) (:pointer g-main-context)
439   (source (:pointer g-source)))
440
441 (defcfun (g-source-set-callback "g_source_set_callback" :library glib) :void
442   (source (:pointer g-source))
443   (func :pointer)
444   (data :pointer)
445   (notify :pointer))
446
447 (defcfun (g-source-add-poll "g_source_add_poll" :library glib) :void
448   (source (:pointer g-source))
449   (fd (:pointer g-poll-fd)))
450
451 (defcfun (g-source-remove-poll "g_source_remove_poll" :library glib) :void
452   (source (:pointer g-source))
453   (fd (:pointer g-poll-fd)))
454
455 (defcfun (g-source-get-current-time "g_source_get_current_time" :library glib) :void
456   (source (:pointer g-source))
457   (timeval-ret (:pointer g-time-val)))
458
459 (defcfun (g-source-remove "g_source_remove" :library glib) :boolean
460   (id :uint))
461
462 (defcfun (g-source-remove-by-funcs-user-data "g_source_remove_by_funcs_user_data" :library glib) :boolean
463   (funcs (:pointer g-source-funcs))
464   (data :pointer))
465
466 (defcfun (g-source-remove-by-user-data "g_source_remove_by_user_data" :library glib) :boolean
467   (data :pointer))
468
469 ;;
470 ;; Core Application Support - Threads
471 ;;
472
473 (defcenum g-thread-error
474   :g-thread-error-again)
475
476 ;omitted: struct GThreadFunctions
477
478 (defcfun (g-thread-init "g_thread_init") :void
479   (vtable :pointer))
480
481 (defcfun g-thread-get-initialized :boolean)
482
483 (at-init ()
484   (unless (g-thread-get-initialized)
485     (g-thread-init (null-pointer))))
486
487 (defcenum g-thread-priority
488   :g-thread-priority-low
489   :g-thread-priority-normal
490   :g-thread-priority-hight
491   :g-thread-priority-urgent)
492
493 ;omitted: g_thread_create, g_thread_create_full, g_thread_yield, g_thread_exit, g_thread_foreach
494
495 (defcfun (g-thread-self "g_thread_self" :library glib) (:pointer g-thread))
496
497 (defcfun (g-thread-join "g_thread_join" :library glib) :pointer
498   (thread (:pointer g-thread)))
499
500 (defcfun (g-thread-priority "g_thread_set_priority" :library glib) :void
501   (thread (:pointer g-thread))
502   (priority g-thread-priority))
503
504 ;;;; TODO: Commented g_mutex_*, g_cond* because they are not functions, but called through dispatch table
505
506 ;; (defcfun (g-mutex-new "g_mutex_new" :library glib) (:pointer g-mutex))
507
508 ;; (defcfun (g-mutex-lock "g_mutex_lock" :library glib) :void
509 ;;   (mutex (:pointer g-mutex)))
510
511 ;; (defcfun (g-mutex-try-lock "g_mutex_trylock" :library glib) :boolean
512 ;;   (mutex (:pointer g-mutex)))
513
514 ;; (defcfun (g-mutex-free "g_mutex_free" :library glib) :void
515 ;;   (mutex (:pointer g-mutex)))
516
517 ;omitted: GStaticMutex, GStaticRWLock stuff
518
519 ;; (defcfun (g-cond-new "g_cond_new" :library glib) (:pointer g-cond))
520
521 ;; (defcfun (g-cond-signal "g_cond_signal" :library glib) :void
522 ;;   (cond (:pointer g-cond)))
523
524 ;; (defcfun (g-cond-broadcast "g_cond_broadcast" :library glib) :void
525 ;;   (cond (:pointer g-cond)))
526
527 ;; (defcfun (g-cond-wait "g_cond_wait" :library glib) :void
528 ;;   (cond (:pointer g-cond))
529 ;;   (mutex (:pointer g-mutex)))
530
531 ;; (defcfun (g-cond-timed-wait "g_cond_timed_wait" :library glib) :boolean
532 ;;   (cond (:pointer g-cond))
533 ;;   (mutex (:pointer g-mutex))
534 ;;   (abs-time (:pointer g-time-val)))
535
536 ;; (defcfun (g-cond-free "g_cond_free" :library glib) :void
537 ;;   (cond (:pointer g-cond)))
538
539 ;omitted: GPrivate, GOnce stuff
540
541 ;omitted: Thread pools, Asynchronous queues, Dynamic Loading of Modules,
542 ; Memory Allocation, IO Channels, Error Reporting, Message Output and Debugging  Functions, Message Logging
543
544 (defcfun g-free :void
545   "@arg[ptr]{pointer previously obtained with @fun{g-malloc} or with g_malloc C function}
546 Frees the pointer by calling g_free on it."
547   (ptr :pointer))
548
549 (defcfun (g-malloc "g_malloc0") :pointer
550   "@arg[n-bytes]{an integer}
551 @return{pointer to beginning of allocated memory}
552 Allocates the specified number of bytes in memory. Calls g_malloc.
553 @see{g-free}"
554   (n-bytes gsize))
555
556 (defcfun g-strdup :pointer
557   "@arg[str]{a @class{string}}
558 @return{foreign pointer to new string}
559 Allocates a new string that is equal to @code{str}. Use @fun{g-free} to free it."
560   (str (:string :free-to-foreign t)))
561
562 ;omitted all GLib Utilites
563
564 (defbitfield g-spawn-flags
565   :leave-descriptors-open :do-not-reap-child :search-path :stdout-to-dev-null :stderr-to-dev-null
566   :child-inherits-stdin :file-and-argv-zero)
567
568 ;TODO: omitted Date and Time Functions