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