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