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