Add GObject/GLib binding

README.org

@@ -1,3 +1,4 @@
-#+TITLE: cl-gio
+#+TITLE: cl-glib
 
-This library serves as a dependency of [[https://github.com/bohonghuang/cl-gtk4][cl-gtk4]] to create ~Application~, requiring ~glib~ and Object Introspection installed in your system.
+This library serves as a dependency of [[https://github.com/bohonghuang/cl-gtk4][cl-gtk4]] to create ~Application~ and provide multi-threading support,
+requiring ~glib~ and Object Introspection installed in your system.

cl-glib.asd

@@ -0,0 +1,20 @@
+(defsystem cl-glib
+  :version "1.0.0"
+  :author "Bohong Huang <1281299809@qq.com>"
+  :maintainer "Bohong Huang <1281299809@qq.com>"
+  :license "lgpl3"
+  :description "GLib binding for Common Lisp."
+  :homepage "https://github.com/BohongHuang/cl-glib"
+  :bug-tracker "https://github.com/BohongHuang/cl-glib/issues"
+  :source-control (:git "https://github.com/BohongHuang/cl-glib.git")
+  :serial t
+  :components ((:file "glib"))
+  :depends-on (#:cl-gobject-introspection-wrapper #:bordeaux-threads))
+
+(uiop:register-image-restore-hook
+ (lambda ()
+   (let* ((namespace "GLib")
+          (package (find-package (string-upcase namespace))))
+     (when package
+       (setf (symbol-value (find-symbol "*NS*" package))
+             (uiop:symbol-call :gir :require-namespace namespace))))))

cl-gio.asd → cl-glib.gio.asd

@@ -1,4 +1,4 @@
-(defsystem cl-gio
+(defsystem cl-glib.gio
   :version "1.0.0"
   :author "Bohong Huang <1281299809@qq.com>"
   :maintainer "Bohong Huang <1281299809@qq.com>"
@@ -8,7 +8,7 @@
   :bug-tracker "https://github.com/BohongHuang/cl-glib/issues"
   :source-control (:git "https://github.com/BohongHuang/cl-glib.git")
   :serial t
-  :components ((:file "package"))
+  :components ((:file "gio"))
   :depends-on (#:cl-gobject-introspection-wrapper))
 
 (uiop:register-image-restore-hook

cl-glib.gobject.asd

@@ -0,0 +1,20 @@
+(defsystem cl-glib.gobject
+  :version "1.0.0"
+  :author "Bohong Huang <1281299809@qq.com>"
+  :maintainer "Bohong Huang <1281299809@qq.com>"
+  :license "lgpl3"
+  :description "GObject binding for Common Lisp."
+  :homepage "https://github.com/BohongHuang/cl-gobject"
+  :bug-tracker "https://github.com/BohongHuang/cl-gobject/issues"
+  :source-control (:git "https://github.com/BohongHuang/cl-gobject.git")
+  :serial t
+  :components ((:file "gobject"))
+  :depends-on (#:cl-gobject-introspection-wrapper))
+
+(uiop:register-image-restore-hook
+ (lambda ()
+   (let* ((namespace "GObject")
+          (package (find-package (string-upcase namespace))))
+     (when package
+       (setf (symbol-value (find-symbol "*NS*" package))
+             (uiop:symbol-call :gir :require-namespace namespace))))))

package.lisp → gio.lisp

@@ -1,4 +1,4 @@
-;;;; package.lisp
+;;;; gio.lisp
 
 ;;;; Copyright (C) 2022 Bohong Huang
 ;;;;

glib.lisp

@@ -0,0 +1,100 @@
+;;;; glib.lisp
+
+;;;; Copyright (C) 2022 Bohong Huang
+;;;;
+;;;; This program is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU Lesser General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public License
+;;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(cl:defpackage glib
+  (:use)
+  (:export #:*ns*))
+
+(cl:in-package #:glib)
+
+(cl:eval-when (:execute :compile-toplevel :load-toplevel)
+  (cl:setf gir-wrapper:*quoted-name-alist* '(("CSET_a_2_z" . +cset-a-z-lower-case+)
+                                             ("CSET_A_2_Z" . +cset-a-z-upper-case+)
+                                             ("t" . time)
+                                             ("timeout_add")
+                                             ("timeout_add_seconds")
+                                             ("idle_add"))))
+
+(gir-wrapper:define-gir-namespace "GLib")
+
+(cl:defvar *objects* (cl:make-hash-table))
+
+(cl:defvar *objects-lock* (bt:make-lock))
+
+(cffi:defcallback funcall-object-callback :bool ((user-data :pointer))
+  (cl:funcall (cl:gethash (cffi:pointer-address user-data) *objects*)))
+
+(cffi:defcallback free-object-callback :void ((user-data :pointer))
+  (bt:with-lock-held (*objects-lock*)
+    (cl:remhash (cffi:pointer-address user-data) *objects*)))
+
+(cl:defconstant +1+maxsizet+ (cl:expt 2 (cl:- (cl:* 8 (cffi:foreign-type-size :pointer)) #+sbcl 2)))
+
+(cl:deftype unsigned-word ()
+  `(cl:integer 0 ,(cl:1- +1+maxsizet+)))
+
+(cl:defun put-object (object)
+  (bt:with-lock-held (*objects-lock*)
+    (cl:loop
+       :with object-id :of-type unsigned-word := 0
+       :do (cl:setf object-id (cl:random +1+maxsizet+))
+       :while (cl:gethash object-id *objects*)
+       :finally
+          (cl:setf (cl:gethash object-id *objects*) object)
+          (cl:return object-id))))
+
+(cl:defun timeout-add (interval function cl:&optional (priority +priority-default+))
+  (gir:invoke (*ns* 'timeout-add)
+              priority
+              interval
+              (cffi:callback funcall-object-callback)
+              (cffi:make-pointer (put-object function))
+              (cffi:callback free-object-callback)))
+
+(cl:export 'timeout-add)
+
+(cl:defun timeout-add-seconds (interval function cl:&optional (priority +priority-default+))
+  (gir:invoke (*ns* 'timeout-add-seconds)
+              priority
+              interval
+              (cffi:callback funcall-object-callback)
+              (cffi:make-pointer (put-object function))
+              (cffi:callback free-object-callback)))
+
+(cl:export 'timeout-add-seconds)
+
+(cl:defun idle-add (function cl:&optional (priority +priority-default+))
+  (gir:invoke (*ns* 'idle-add)
+              priority
+              (cffi:callback funcall-object-callback)
+              (cffi:make-pointer (put-object function))
+              (cffi:callback free-object-callback)))
+
+(cl:export 'idle-add)
+
+(cl:defun funcall (function cl:&rest arguments)
+  (idle-add (cl:lambda () (cl:apply function arguments) cl:nil)))
+
+(cl:export 'funcall)
+
+(cl:defmacro with-main-event-loop (cl:&body body)
+  `(funcall (cl:lambda () ,@body)))
+
+(cl:export 'with-main-event-loop)
+
+(cl:eval-when (:execute :compile-toplevel :load-toplevel)
+  (cl:setf gir-wrapper:*quoted-name-alist* cl:nil))

gobject.lisp

@@ -0,0 +1,24 @@
+;;;; gobject.lisp
+
+;;;; Copyright (C) 2022 Bohong Huang
+;;;;
+;;;; This program is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU Lesser General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public License
+;;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+(cl:defpackage gobject
+  (:nicknames #:gobj)
+  (:export #:*ns*))
+
+(cl:in-package #:gobj)
+
+(gir-wrapper:define-gir-namespace "GObject")