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