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