Add display-add-client-message-handler and gdk-spawn-on-screen

diff --git a/gdk/gdk.display.lisp b/gdk/gdk.display.lisp
index 2d773f6..c7ef136 100644 (file)
--- a/gdk/gdk.display.lisp
+++ b/gdk/gdk.display.lisp
@@ -55,11 +55,16 @@
   (event (g-boxed-foreign event)))
 (export 'display-put-event)
 
-;void                gdk_display_add_client_message_filter
-;                                                        (GdkDisplay *display,
-;                                                         GdkAtom message_type,
-;                                                         GdkFilterFunc func,
-;                                                         gpointer data);
+(defcfun gdk_display_add_client_message_filter :void
+  (display (g-object display))
+  (message-type gdk-atom-as-string)
+  (func :pointer)
+  (data :pointer))
+
+(defun dispaly-add-client-message-filter (display message-type fn)
+  (gdk_display_add_client_message_filter display message-type (callback gdk-client-message-filter-func) (allocate-stable-pointer fn)))
+
+(export 'display-add-client-message-filter)
 
 (defcfun (display-set-double-click-time "gdk_display_set_double_click_time") :void
   (display (g-object display))
@@ -99,6 +104,7 @@
 
 (export 'display-get-window-at-pointer)
 
+; ignored:
 ;GdkDisplayPointerHooks * gdk_display_set_pointer_hooks  (GdkDisplay *display,
 ;                                                         const GdkDisplayPointerHooks *new_hooks);
 

diff --git a/gdk/gdk.screen.lisp b/gdk/gdk.screen.lisp
index cbc847e..29215d7 100644 (file)
--- a/gdk/gdk.screen.lisp
+++ b/gdk/gdk.screen.lisp
@@ -71,3 +71,86 @@
     (gdk-spawn-command-line-on-screen screen command-line err)))
 
 (export 'spawn-command-line-on-screen)
+
+(defcfun gdk_spawn_on_screen :boolean
+  (screen (g-object screen))
+  (working-directory :string)
+  (argv :pointer)
+  (envp :pointer)
+  (flags glib:g-spawn-flags)
+  (child-setup :pointer)
+  (user-data :pointer)
+  (child-pid (:pointer :int))
+  (g-error :pointer))
+
+(defcfun gdk_spawn_on_screen_with_pipes :boolean
+  (screen (g-object screen))
+  (working-directory :string)
+  (argv :pointer)
+  (envp :pointer)
+  (flags glib:g-spawn-flags)
+  (child-setup :pointer)
+  (user-data :pointer)
+  (child-pid (:pointer :int))
+  (std-input (:pointer :int))
+  (std-output (:pointer :int))
+  (std-err (:pointer :int))
+  (g-error :pointer))
+
+(defmacro with-foreign-string-array ((var strings &key (null-terminated t)) &body body)
+  (let ((strings-var (gensym))
+        (s (gensym))
+        (i (gensym))
+        (n (gensym)))
+    `(let* ((,strings-var ,strings)
+            (,n (length ,strings-var)))
+       (with-foreign-object (,var :pointer ,(if null-terminated `(1+ ,n) `,n))
+         (iter (for ,s in ,strings-var)
+               (for ,i from 0)
+               (setf (mem-aref ,var :pointer ,i) (foreign-string-alloc ,s))
+               ,@(when null-terminated
+                       (list `(finally (setf (mem-aref ,var :pointer ,n) (null-pointer))))))
+         (unwind-protect (progn ,@body)
+           (iter (for ,i from 0 below ,n)
+                 (foreign-string-free (mem-aref ,var :pointer ,i))))))))
+
+(defun gdk-spawn-on-screen (screen argv &key working-directory env (flags '(:search-path)) with-pipes)
+  (unless working-directory (setf working-directory (null-pointer)))
+  (glib:with-g-error (err)
+    (with-foreign-objects ((pid :int) (stdin :int) (stdout :int) (stderr :int))
+      (with-foreign-string-array (argvp argv)
+        (if (null env)
+            (if with-pipes
+                (gdk_spawn_on_screen_with_pipes screen
+                                                working-directory
+                                                argvp
+                                                (null-pointer)
+                                                flags
+                                                (null-pointer)
+                                                (null-pointer)
+                                                pid stdin stdout stderr err)
+                (gdk_spawn_on_screen screen
+                                     working-directory
+                                     argvp
+                                     (null-pointer)
+                                     flags
+                                     (null-pointer)
+                                     (null-pointer)
+                                     pid err))
+            (with-foreign-string-array (envp env)
+              (if with-pipes
+                  (gdk_spawn_on_screen_with_pipes screen
+                                                  working-directory
+                                                  argvp envp flags
+                                                  (null-pointer) (null-pointer)
+                                                  pid stdin stdout stderr err)
+                  (gdk_spawn_on_screen screen
+                                       working-directory
+                                       argvp envp
+                                       flags (null-pointer) (null-pointer)
+                                       pid err)))))
+      (if with-pipes
+          (values (mem-ref pid :int) (mem-ref stdin :int) (mem-ref stdout :int) (mem-ref stderr :int))
+          (mem-ref pid :int)))))
+
+(export 'gdk-spawn-on-screen)

diff --git a/gdk/gdk.threads.lisp b/gdk/gdk.threads.lisp
index 268c05a..fc13d8e 100644 (file)
--- a/gdk/gdk.threads.lisp
+++ b/gdk/gdk.threads.lisp
@@ -9,6 +9,7 @@
 (defcfun gdk-threads-leave :void)
 (export 'gdk-threads-leave)
 
+;; ignored:
 ;; void                gdk_threads_set_lock_functions      (GCallback enter_fn,
 ;;                                                          GCallback leave_fn);
 

diff --git a/glib/glib.lisp b/glib/glib.lisp
index 39791f5..9507fef 100755 (executable)
--- a/glib/glib.lisp
+++ b/glib/glib.lisp
@@ -32,7 +32,8 @@
            #:g-error-condition
            #:g-error-condition-domain
            #:g-error-condition-code
-           #:g-error-condition-message)
+           #:g-error-condition-message
+           #:g-spawn-flags)
   (:documentation
    "Cl-gtk2-glib is wrapper for @a[http://library.gnome.org/devel/glib/]{GLib}."))
 
@@ -512,5 +513,9 @@ Allocates a new string that is equal to @code{str}. Use @fun{g-free} to free it.
   (str (:string :free-to-foreign t)))
 
 ;omitted all GLib Utilites
-;TODO: omitted Date and Time Functions
 
+(defbitfield g-spawn-flags
+  :leave-descriptors-open :do-not-reap-child :search-path :stdout-to-dev-null :stderr-to-dev-null
+  :child-inherits-stdin :file-and-argv-zero)
+
+;TODO: omitted Date and Time Functions