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