From e469002e1f9cea158367cc18344817ec6d1c776f Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Sat, 21 Nov 2009 01:04:52 +0300 Subject: [PATCH] Add display-add-client-message-handler and gdk-spawn-on-screen --- gdk/gdk.display.lisp | 16 +++++++--- gdk/gdk.screen.lisp | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++ gdk/gdk.threads.lisp | 1 + glib/glib.lisp | 9 ++++-- 4 files changed, 102 insertions(+), 7 deletions(-) diff --git a/gdk/gdk.display.lisp b/gdk/gdk.display.lisp index 2d773f6..c7ef136 100644 --- 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 --- 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 --- 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 --- 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 -- 1.7.10.4