XDG functions are added
authorAndrey Kutejko <andy128k@gmail.com>
Tue, 22 Dec 2009 22:58:38 +0000 (00:58 +0200)
committerDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Fri, 22 Jan 2010 10:47:57 +0000 (13:47 +0300)
glib/cl-gtk2-glib.asd
glib/glib.utils.lisp [new file with mode: 0644]

index cc11c70..908923f 100644 (file)
@@ -10,6 +10,7 @@
                (:file "glib.string")
                (:file "glib.quark")
                (:file "glib.gerror")
+               (:file "glib.utils")
 
                (:file "gobject.init")
                (:file "gobject.ffi.package")
@@ -38,4 +39,4 @@
                
                (:file "gobject.boxed")
                (:file "gobject.object-function"))
-  :depends-on (:cffi :trivial-garbage :iterate :bordeaux-threads :iterate :closer-mop))
\ No newline at end of file
+  :depends-on (:cffi :trivial-garbage :iterate :bordeaux-threads :iterate :closer-mop))
diff --git a/glib/glib.utils.lisp b/glib/glib.utils.lisp
new file mode 100644 (file)
index 0000000..77cf03f
--- /dev/null
@@ -0,0 +1,46 @@
+(in-package :glib)
+
+(defcfun g-get-user-cache-dir :string)
+
+(defun get-user-cache-dir ()
+  (g-get-user-cache-dir))
+
+(export 'get-user-cache-dir)
+
+(defcfun g-get-user-data-dir :string)
+
+(defun get-user-data-dir ()
+  (g-get-user-data-dir))
+
+(export 'get-user-data-dir)
+
+(defcfun g-get-user-config-dir :string)
+
+(defun get-user-config-dir ()
+  (g-get-user-config-dir))
+
+(export 'get-user-config-dir)
+
+(defcfun g-build-filenamev (:string :free-from-foreign t)
+  (args :pointer))
+
+(defun build-filename (&rest args)
+  (let* ((n (length args))
+         (arr (g-malloc (* (1+ n) (foreign-type-size :pointer)))))
+
+    (iter (for i from 0)
+          (for arg in args)
+          (setf (mem-aref arr :pointer i) (g-strdup arg)))
+    (setf (mem-aref arr :pointer n) (null-pointer))
+
+    (prog1
+      (g-build-filenamev arr)
+
+      (iter (for i from 0)
+            (for str-ptr = (mem-aref arr :pointer i))
+            (until (null-pointer-p str-ptr))
+            (g-free str-ptr))
+      (g-free arr))))
+
+(export 'build-filename)
+