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