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