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