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   (:documentation
  37    "Cl-gtk2-glib is wrapper for @a[http://library.gnome.org/devel/glib/]{GLib}."))
  38
  39 (in-package :glib)
  40
  41 (eval-when (:compile-toplevel :load-toplevel :execute)
  42   (defvar *initializers-table* (make-hash-table :test 'equalp))
  43   (defvar *initializers* nil)
  44   (defun register-initializer (key fn)
  45     (unless (gethash key *initializers-table*)
  46       (setf (gethash key *initializers-table*) t
  47             *initializers* (nconc *initializers* (list fn)))))
  48   (defvar *finalizers-table* (make-hash-table :test 'equalp))
  49   (defvar *finalizers* nil)
  50   (defun register-finalizer (key fn)
  51     (unless (gethash key *finalizers-table*)
  52       (setf (gethash key *finalizers-table*) t
  53             *finalizers* (nconc *finalizers* (list fn))))))
  54
  55 (defun run-initializers ()
  56   (iter (for fn in *initializers*)
  57         (funcall fn)))
  58
  59 (defun run-finalizers ()
  60   (iter (for fn in *finalizers*)
  61         (funcall fn)))
  62
  63 #+sbcl
  64 (pushnew 'run-initializers sb-ext:*init-hooks*)
  65 #+openmcl
  66 (pushnew 'run-initializers ccl:*restore-lisp-functions*)
  67
  68 #+sbcl
  69 (pushnew 'run-finalizers sb-ext:*save-hooks*)
  70 #+openmcl
  71 (pushnew 'run-finalizers ccl:*save-exit-functions*)
  72
  73 (defmacro at-init ((&rest keys) &body body)
  74   "
  75 @arg[keys]{list of expression}
  76 @arg[body]{the code}
  77 Runs the code normally but also schedules the code to be run at image load time.
  78 It is used to reinitialize the libraries when the dumped image is loaded. (Works only on SBCL for now).
  79
  80 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).
  81
  82 Example:
  83 @begin{pre}
  84 \(defmethod initialize-instance :after ((class gobject-class) &key &allow-other-keys)
  85   (register-object-type (gobject-class-g-type-name class) (class-name class))
  86   (at-init (class) (initialize-gobject-class-g-type class)))
  87 @end{pre}
  88
  89 In this example, for every @code{class}, @code{(initialize-gobject-class-g-type class)} will be called only once.
  90 "
  91   `(progn (register-initializer (list ,@keys ',body) (lambda () ,@body))
  92           ,@body))
  93
  94 (defmacro at-finalize ((&rest keys) &body body)
  95   `(register-finalizer (list ,@keys ',body) (lambda () ,@body)))
  96
  97 (at-init ()
  98   (eval-when (:compile-toplevel :load-toplevel :execute)
  99     (define-foreign-library glib
 100       (:unix (:or "libglib-2.0.so.0" "libglib-2.0.so"))
 101       (:windows "libglib-2.0-0.dll")
 102       (t (:default "libglib-2.0"))))
 103   (eval-when (:compile-toplevel :load-toplevel :execute)
 104     (define-foreign-library gthread
 105       (:unix (:or "libgthread-2.0.so.0"  "libgthread-2.0.so"))
 106       (:windows "libgthread-2.0-0.dll")
 107       (t "libgthread-2.0")))
 108
 109   (use-foreign-library glib)
 110   (use-foreign-library gthread))
 111
 112 ;;
 113 ;; Glib Fundamentals
 114 ;;
 115
 116 ;;
 117 ;; Fundamentals - Basic types
 118 ;;
 119
 120
 121 ;; TODO: not sure about these: for amd64 they are ok
 122 (eval-when (:compile-toplevel :load-toplevel :execute)
 123   (cond
 124     ((cffi-features:cffi-feature-p :x86-64) (defctype gsize :uint64))
 125     ((cffi-features:cffi-feature-p :x86) (defctype gsize :ulong))
 126     (t (error "Can not define 'gsize', unknown CPU architecture (known are x86 and x86-64)"))))
 127
 128 (defctype gssize :long)
 129
 130 (defctype goffset :uint64)
 131
 132
 133 ;;
 134 ;; Fundamentals - Version information
 135 ;;
 136
 137 (defcvar (*glib-major-version* "glib_major_version" :read-only t :library glib) :uint)
 138 (defcvar (*glib-minor-version* "glib_minor_version" :read-only t :library glib) :uint)
 139 (defcvar (*glib-micro-version* "glib_micro_version" :read-only t :library glib) :uint)
 140 (defcvar (*glib-binary-age* "glib_binary_age" :read-only t :library glib) :uint)
 141 (defcvar (*glib-interface-age* "glib_interface_age" :read-only t :library glib) :uint)
 142
 143 ;;
 144 ;; Omitted:
 145 ;; Limits of Basic Types, Standard Macros, Type Conversion Macros, Byte Order Macros,
 146 ;; Numerical Definitions, Miscellaneous Macros, Atomic operations
 147 ;;
 148
 149 ;; Core Application Support - The Main Event Loop
 150
 151 (defcstruct g-main-loop)
 152 (defcstruct g-main-context)
 153 (defcstruct g-source)
 154 (defcstruct g-source-funcs
 155   (prepare :pointer)
 156   (check :pointer)
 157   (dispatch :pointer)
 158   (finalize :pointer)
 159   (closure-callback :pointer)
 160   (closure-marshal :pointer))
 161 (defcstruct g-source-callback-funcs
 162   (ref :pointer)
 163   (unref :pointer)
 164   (get :pointer))
 165 (defcstruct g-cond)
 166 (defcstruct g-mutex)
 167
 168 (defcstruct g-poll-fd
 169   (fd :int) ;; TODO: #if defined (G_OS_WIN32) && GLIB_SIZEOF_VOID_P == 8
 170   (events :ushort)
 171   (revent :ushort))
 172
 173 (defcstruct g-time-val
 174   (seconds :long)
 175   (microseconds :long))
 176
 177 (defcstruct g-thread)
 178
 179 (defcfun (g-main-loop-new "g_main_loop_new" :library glib) (:pointer g-main-loop)
 180   (context (:pointer g-main-context))
 181   (is-running :boolean))
 182
 183 (defcfun (g-main-loop-ref "g_main_loop_ref" :library glib) (:pointer g-main-loop)
 184   (loop (:pointer g-main-loop)))
 185
 186 (defcfun (g-main-loop-unref "g_main_loop_unref" :library glib) (:pointer g-main-loop)
 187   (loop (:pointer g-main-loop)))
 188
 189 (defcfun (g-main-loop-run "g_main_loop_run" :library glib) :void
 190   (loop (:pointer g-main-loop)))
 191
 192 (defcfun (g-main-loop-quit "g_main_loop_quit" :library glib) :void
 193   (loop (:pointer g-main-loop)))
 194
 195 (defcfun (g-main-loop-is-running "g_main_loop_is_running" :library glib) :boolean
 196   (loop (:pointer g-main-loop)))
 197
 198 (defcfun (g-main-loop-get-context "g_main_loop_get_context" :library glib) (:pointer g-main-context)
 199   (loop (:pointer g-main-loop)))
 200
 201 (defconstant +g-priority-high+ -100 "Use this for high priority event sources. It is not used within GLib or GTK+.")
 202 (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.")
 203 (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.)")
 204 (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().")
 205 (defconstant +g-priority-low+ 300 "Use this for very low priority background tasks. It is not used within GLib or GTK+.")
 206
 207 (defcfun (g-main-context-new "g_main_context_new" :library glib) (:pointer g-main-context))
 208
 209 (defcfun (g-main-context-ref "g_main_context_ref" :library glib) (:pointer g-main-context)
 210   (context (:pointer g-main-context)))
 211
 212 (defcfun (g-main-context-unref "g_main_context_unref" :library glib) (:pointer g-main-context)
 213   (context (:pointer g-main-context)))
 214
 215 (defcfun (g-main-context-default "g_main_context_default" :library glib) (:pointer g-main-context))
 216
 217 (defcfun (g-main-context-iteration "g_main_context_iteration" :library glib) :boolean
 218   (context (:pointer g-main-context))
 219   (may-block :boolean))
 220
 221 (defcfun (g-main-context-pending "g_main_context_pending" :library glib) :boolean
 222   (context (:pointer g-main-context)))
 223
 224 (defcfun (g-main-context-find-source-by-id "g_main_context_find_source_by_id" :library glib) (:pointer g-source)
 225   (context (:pointer g-main-context))
 226   (source-id :uint))
 227
 228 (defcfun (g-main-context-find-source-by-user-data "g_main_context_find_source_by_user_data" :library glib) (:pointer g-source)
 229   (context (:pointer g-main-context))
 230   (user-data :pointer))
 231
 232 (defcfun (g-main-context-find-source-by-funcs-user-data "g_main_context_find_source_by_funcs_user_data" :library glib) (:pointer g-source)
 233   (context (:pointer g-main-context))
 234   (funcs (:pointer g-source-funcs))
 235   (user-data :pointer))
 236
 237 (defcfun (g-main-context-wakeup "g_main_context_wakeup" :library glib) :void
 238   (context (:pointer g-main-context)))
 239
 240 (defcfun (g-main-context-acquire "g_main_context_acquire" :library glib) :boolean
 241   (context (:pointer g-main-context)))
 242
 243 (defcfun (g-main-context-release "g_main_context_release" :library glib) :void
 244   (context (:pointer g-main-context)))
 245
 246 (defcfun (g-main-context-is-owner "g_main_context_is_owner" :library glib) :boolean
 247   (context (:pointer g-main-context)))
 248
 249 (defcfun (g-main-context-wait "g_main_context_wait" :library glib) :boolean
 250   (context (:pointer g-main-context))
 251   (cond (:pointer g-cond))
 252   (mutex (:pointer g-mutex)))
 253
 254 (defcfun (g_main_context_prepare "g_main_context_prepare" :library glib) :boolean
 255   (context (:pointer g-main-context))
 256   (priority-ret (:pointer :int)))
 257
 258 (defcfun (g_main_context_query "g_main_context_query" :library glib) :int
 259   (context (:pointer g-main-context))
 260   (max-priority :int)
 261   (timeout-ret (:pointer :int))
 262   (fds-ret (:pointer g-poll-fd))
 263   (n-dfs :int))
 264
 265 (defcfun (g-main-context-check "g_main_context_check" :library glib) :int
 266   (context (:pointer g-main-context))
 267   (max-priority :int)
 268   (fds (:pointer g-poll-fd))
 269   (n-fds :int))
 270
 271 (defcfun (g-main-context-dispatch "g_main_context_dispatch" :library glib) :void
 272   (context (:pointer g-main-context)))
 273
 274 (defcfun (g-main-context-set-poll-func "g_main_context_set_poll_func" :library glib) :void
 275   (context (:pointer g-main-context))
 276   (func :pointer))
 277
 278 (defcfun (g-main-context-get-poll-func "g_main_context_get_poll_func" :library glib) :pointer
 279   (context (:pointer g-main-context)))
 280
 281 (defcfun (g-main-context-add-poll "g_main_context_add_poll" :library glib) :void
 282   (context (:pointer g-main-context))
 283   (fd (:pointer g-poll-fd))
 284   (priority :int))
 285
 286 (defcfun (g-main-context-remove-poll "g_main_context_remove_poll" :library glib) :void
 287   (context (:pointer g-main-context))
 288   (fd (:pointer g-poll-fd)))
 289
 290 (defcfun (g-main-depth "g_main_depth" :library glib) :int)
 291
 292 (defcfun (g-main-current-source "g_main_current_source" :library glib) (:pointer g-source))
 293
 294 (defcfun (g-timeout-source-new "g_timeout_source_new" :library glib) (:pointer g-source)
 295   (interval-milliseconds :int))
 296
 297 (defcfun (g-timeout-source-new-seconds "g_timeout_source_new_seconds" :library glib) (:pointer g-source)
 298   (interval-seconds :int))
 299
 300 (defcfun (g-timeout-add "g_timeout_add" :library glib) :uint
 301   (interval-milliseconds :uint)
 302   (function :pointer)
 303   (data :pointer))
 304
 305 (defcfun (g-timeout-add-full "g_timeout_add_full" :library glib) :uint
 306   (priority :int)
 307   (interval-milliseconds :uint)
 308   (function :pointer)
 309   (data :pointer)
 310   (destroy-notify :pointer))
 311
 312 (defcfun (g-timeout-add-seconds "g_timeout_add_seconds" :library glib) :uint
 313   (interval-seconds :uint)
 314   (function :pointer)
 315   (data :pointer))
 316
 317 (defcfun (g-timeout-add-seconds-full "g_timeout_add_seconds_full" :library glib) :uint
 318   (priority :int)
 319   (interval-seconds :uint)
 320   (function :pointer)
 321   (data :pointer)
 322   (destroy-notify :pointer))
 323
 324 (defcfun (g-idle-source-new "g_idle_source_new" :library glib) (:pointer g-source))
 325
 326 (defcfun (g-idle-add "g_idle_add" :library glib) :uint
 327   (function :pointer)
 328   (data :pointer))
 329
 330 (defcfun (g-idle-add-full "g_idle_add_full" :library glib) :uint
 331   "A low-level function for adding callbacks to be called from main loop. Wrapper around g_idle_add_full.
 332 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.
 333 @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+}.}
 334 @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}
 335 @arg[data]{pointer that will be passed to callback function}
 336 @arg[notify]{function that will be called when callback is no more needed. It will receive the @code{data} argument}"
 337   (priority :uint)
 338   (function :pointer)
 339   (data :pointer)
 340   (notify :pointer))
 341
 342 (defcfun (g-idle-remove-by-data "g_idle_remove_by_data" :library glib) :boolean
 343   (data :pointer))
 344
 345 ;(defctype g-pid :int) ;;TODO: might work on amd64 linux, but on others
 346
 347 ;; Omitted GPid, g_child_add_watch, g_child_add_watch_full
 348
 349 (defcfun (g-source-new "g_source_new" :library glib) (:pointer g-source)
 350   (source-funcs (:pointer g-source-funcs))
 351   (struct-size :uint))
 352
 353 (defcfun (g-source-ref "g_source_ref" :library glib) (:pointer g-source)
 354   (source (:pointer g-source)))
 355
 356 (defcfun (g-source-unref "g_source_unref" :library glib) :void
 357   (source (:pointer g-source)))
 358
 359 (defcfun (g-source-set-funcs "g_source_set_funcs" :library glib) :void
 360   (source (:pointer g-source))
 361   (funcs (:pointer g-source-funcs)))
 362
 363 (defcfun (g-source-attach "g_source_attach" :library glib) :uint
 364   (source (:pointer g-source))
 365   (context (:pointer g-main-context)))
 366
 367 (defcfun (g-source-destroy "g_source_destroy" :library glib) :void
 368   (source (:pointer g-source)))
 369
 370 (defcfun (g-source-is-destroyed "g_source_is_destroyed" :library glib) :boolean
 371   (source (:pointer g-source)))
 372
 373 (defcfun (g-source-set-priority "g_source_set_priority" :library glib) :void
 374   (source (:pointer g-source))
 375   (priority :int))
 376
 377 (defcfun (g-source-get-priority "g_source_get_priority" :library glib) :int
 378   (source (:pointer g-source)))
 379
 380 (defcfun (g-source-set-can-recurse "g_source_set_can_recurse" :library glib) :void
 381   (source (:pointer g-source))
 382   (can-recurse :boolean))
 383
 384 (defcfun (g-source-get-can-recurse "g_source_get_can_recurse" :library glib) :boolean
 385   (source (:pointer g-source)))
 386
 387 (defcfun (g-source-get-id "g_source_get_id" :library glib) :uint
 388   (source (:pointer g-source)))
 389
 390 (defcfun (g-source-get-context "g_source_get_context" :library glib) (:pointer g-main-context)
 391   (source (:pointer g-source)))
 392
 393 (defcfun (g-source-set-callback "g_source_set_callback" :library glib) :void
 394   (source (:pointer g-source))
 395   (func :pointer)
 396   (data :pointer)
 397   (notify :pointer))
 398
 399 (defcfun (g-source-add-poll "g_source_add_poll" :library glib) :void
 400   (source (:pointer g-source))
 401   (fd (:pointer g-poll-fd)))
 402
 403 (defcfun (g-source-remove-poll "g_source_remove_poll" :library glib) :void
 404   (source (:pointer g-source))
 405   (fd (:pointer g-poll-fd)))
 406
 407 (defcfun (g-source-get-current-time "g_source_get_current_time" :library glib) :void
 408   (source (:pointer g-source))
 409   (timeval-ret (:pointer g-time-val)))
 410
 411 (defcfun (g-source-remove "g_source_remove" :library glib) :boolean
 412   (id :uint))
 413
 414 (defcfun (g-source-remove-by-funcs-user-data "g_source_remove_by_funcs_user_data" :library glib) :boolean
 415   (funcs (:pointer g-source-funcs))
 416   (data :pointer))
 417
 418 (defcfun (g-source-remove-by-user-data "g_source_remove_by_user_data" :library glib) :boolean
 419   (data :pointer))
 420
 421 ;;
 422 ;; Core Application Support - Threads
 423 ;;
 424
 425 (defcenum g-thread-error
 426   :g-thread-error-again)
 427
 428 ;omitted: struct GThreadFunctions
 429
 430 (defcfun (g-thread-init "g_thread_init") :void
 431   (vtable :pointer))
 432
 433 (defcfun g-thread-get-initialized :boolean)
 434
 435 (at-init ()
 436   (unless (g-thread-get-initialized)
 437     (g-thread-init (null-pointer))))
 438
 439 (defcenum g-thread-priority
 440   :g-thread-priority-low
 441   :g-thread-priority-normal
 442   :g-thread-priority-hight
 443   :g-thread-priority-urgent)
 444
 445 ;omitted: g_thread_create, g_thread_create_full, g_thread_yield, g_thread_exit, g_thread_foreach
 446
 447 (defcfun (g-thread-self "g_thread_self" :library glib) (:pointer g-thread))
 448
 449 (defcfun (g-thread-join "g_thread_join" :library glib) :pointer
 450   (thread (:pointer g-thread)))
 451
 452 (defcfun (g-thread-priority "g_thread_set_priority" :library glib) :void
 453   (thread (:pointer g-thread))
 454   (priority g-thread-priority))
 455
 456 ;;;; TODO: Commented g_mutex_*, g_cond* because they are not functions, but called through dispatch table
 457
 458 ;; (defcfun (g-mutex-new "g_mutex_new" :library glib) (:pointer g-mutex))
 459
 460 ;; (defcfun (g-mutex-lock "g_mutex_lock" :library glib) :void
 461 ;;   (mutex (:pointer g-mutex)))
 462
 463 ;; (defcfun (g-mutex-try-lock "g_mutex_trylock" :library glib) :boolean
 464 ;;   (mutex (:pointer g-mutex)))
 465
 466 ;; (defcfun (g-mutex-free "g_mutex_free" :library glib) :void
 467 ;;   (mutex (:pointer g-mutex)))
 468
 469 ;omitted: GStaticMutex, GStaticRWLock stuff
 470
 471 ;; (defcfun (g-cond-new "g_cond_new" :library glib) (:pointer g-cond))
 472
 473 ;; (defcfun (g-cond-signal "g_cond_signal" :library glib) :void
 474 ;;   (cond (:pointer g-cond)))
 475
 476 ;; (defcfun (g-cond-broadcast "g_cond_broadcast" :library glib) :void
 477 ;;   (cond (:pointer g-cond)))
 478
 479 ;; (defcfun (g-cond-wait "g_cond_wait" :library glib) :void
 480 ;;   (cond (:pointer g-cond))
 481 ;;   (mutex (:pointer g-mutex)))
 482
 483 ;; (defcfun (g-cond-timed-wait "g_cond_timed_wait" :library glib) :boolean
 484 ;;   (cond (:pointer g-cond))
 485 ;;   (mutex (:pointer g-mutex))
 486 ;;   (abs-time (:pointer g-time-val)))
 487
 488 ;; (defcfun (g-cond-free "g_cond_free" :library glib) :void
 489 ;;   (cond (:pointer g-cond)))
 490
 491 ;omitted: GPrivate, GOnce stuff
 492
 493 ;omitted: Thread pools, Asynchronous queues, Dynamic Loading of Modules,
 494 ; Memory Allocation, IO Channels, Error Reporting, Message Output and Debugging  Functions, Message Logging
 495
 496 (defcfun g-free :void
 497   "@arg[ptr]{pointer previously obtained with @fun{g-malloc} or with g_malloc C function}
 498 Frees the pointer by calling g_free on it."
 499   (ptr :pointer))
 500
 501 (defcfun (g-malloc "g_malloc0") :pointer
 502   "@arg[n-bytes]{an integer}
 503 @return{pointer to beginning of allocated memory}
 504 Allocates the specified number of bytes in memory. Calls g_malloc.
 505 @see{g-free}"
 506   (n-bytes gsize))
 507
 508 (defcfun g-strdup :pointer
 509   "@arg[str]{a @class{string}}
 510 @return{foreign pointer to new string}
 511 Allocates a new string that is equal to @code{str}. Use @fun{g-free} to free it."
 512   (str (:string :free-to-foreign t)))
 513
 514 ;omitted all GLib Utilites
 515 ;TODO: omitted Date and Time Functions
 516