Menu
▾
▴
clisp-cvs Digest, Vol 28, Issue 23
|
From: <cli...@li...> - 2008-08-21 18:59:59
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/modules/dbus test.tst,1.1,1.2 (Sam Steingold) 2. clisp/modules/rawsock test.tst,1.51,1.52 (Sam Steingold) 3. clisp/modules/syscalls test.tst,1.77,1.78 (Sam Steingold) 4. clisp/modules/dbus test.tst,1.2,1.3 (Sam Steingold) 5. clisp/src ChangeLog,1.6483,1.6484 lispbibl.d,1.811,1.812 (Sam Steingold) 6. clisp/src ChangeLog,1.6484,1.6485 (Sam Steingold) 7. clisp/modules/syscalls calls.c,1.248,1.249 (Sam Steingold) 8. clisp/src ChangeLog,1.6485,1.6486 foreign.d,1.186,1.187 (Sam Steingold) 9. clisp/src ChangeLog,1.6486,1.6487 (Sam Steingold) 10. clisp/modules/dbus dbus.lisp,1.7,1.8 test.tst,1.3,1.4 (Sam Steingold) ---------------------------------------------------------------------- Message: 1 Date: Wed, 20 Aug 2008 19:43:35 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/dbus test.tst,1.1,1.2 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/modules/dbus In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv16622/modules/dbus Modified Files: test.tst Log Message: code from http://dbus.freedesktop.org/doc/dbus/libdbus-tutorial.html Index: test.tst =================================================================== RCS file: /cvsroot/clisp/clisp/modules/dbus/test.tst,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- test.tst 31 Jul 2008 20:46:14 -0000 1.1 +++ test.tst 20 Aug 2008 19:43:33 -0000 1.2 @@ -3,3 +3,230 @@ ;; clisp -K full -E 1:1 -q -norc -i ../tests/tests -x '(run-test "dbus/test")' dbus:DBUS_MAJOR_PROTOCOL_VERSION 1 + +(stringp (show dbus:DBUS_SERVICE_DBUS)) T +(stringp (show dbus:DBUS_PATH_DBUS)) T +(stringp (show dbus:DBUS_PATH_LOCAL)) T + +;; http://dbus.freedesktop.org/doc/dbus/libdbus-tutorial.html + +;; == Common Code +(defparameter *dbus-error* (ffi:allocate-shallow 'dbus:DBusError)) *DBUS-ERROR* +(multiple-value-list (dbus:dbus_error_init *dbus-error*)) () +(ffi:foreign-value *dbus-error*) +#S(DBUS:DBusError :NAME NIL :MESSAGE NIL :DUMMY1 1 :DUMMY2 0 :DUMMY3 0 + :DUMMY4 0 :DUMMY5 0 :PADDING NIL) +(defparameter *dbus-conn* + (dbus:dbus_bus_get dbus:DBUS_BUS_SESSION *dbus-error*)) +*DBUS-CONN* +(null *dbus-conn*) NIL +(dbus:dbus_error_is_set *dbus-error*) 0 ; connection success + +;; == Sending a Signal +(defparameter *dbus-msg* ; create a signal + (dbus:dbus_message_new_signal + "/test/signal/Object" ; object name of the signal + "test.signal.Type" ; interface name of the signal + "Test")) ; name +*DBUS-MSG* +(null *dbus-msg*) NIL + +;; send the message and flush the connection +(multiple-value-list (dbus:dbus_connection_send *dbus-conn* *dbus-msg*)) (1 2) +(multiple-value-list (dbus:dbus_connection_flush *dbus-conn*)) () +;; free the message +(multiple-value-list (dbus:dbus_message_unref *dbus-msg*)) () + +;; == Calling a Method +#+(or) (progn ; crash in dbus_connection_send_with_reply +(defparameter *dbus-msg* + (dbus:dbus_message_new_method_call + "test.method.server" ; target for the method call + "/test/method/Object" ; object to call on + "test.method.Type" ; interface to call on + "Method")) ; method name +*DBUS-MSG* +(null *dbus-msg*) NIL + +(defparameter *dbus-args* (ffi:allocate-shallow 'dbus:DBusMessageIter)) +*DBUS-ARGS* +(defparameter *dbus-param* + (ffi:allocate-deep '(ffi:c-array-max character 256) "abazonk")) +*DBUS-PARAM* +(defparameter *dbus-param-addr* + (ffi:allocate-deep 'ffi:c-pointer + (ffi:c-var-address (ffi:foreign-value *dbus-param*)))) +*DBUS-PARAM-ADDR* + +;; append arguments +(multiple-value-list + (dbus:dbus_message_iter_init_append *dbus-msg* *dbus-args*)) () +(dbus:dbus_message_iter_append_basic + *dbus-args* dbus:DBUS_TYPE_STRING *dbus-param-addr*) +1 + +(defparameter *dbus-pending* + (multiple-value-bind (status pending) + ;; send message and get a handle for a reply + (dbus:dbus_connection_send_with_reply *dbus-conn* *dbus-msg* -1) + ; -1 is default timeout + (assert (= status 1)) + pending)) +*DBUS-PENDING* +(null *dbus-pending*) NIL + +(multiple-value-list (dbus:dbus_connection_flush *dbus-conn*)) () +;; free the message +(multiple-value-list (dbus:dbus_message_unref *dbus-msg*)) () + +;; block until we receive a reply +(multiple-value-list (dbus:dbus_pending_call_block *dbus-pending*)) () + +;; get the reply message +(defparameter *dbus-msg* (dbus:dbus_pending_call_steal_reply *dbus-pending*)) +*DBUS-MSG* +(null *dbus-msg*) NIL + +;; free the pending message handle +(multiple-value-list (dbus:dbus_pending_call_unref *dbus-pending*)) () + +;; read the parameters +(dbus:dbus_message_iter_init *dbus-msg* *dbus-args*) 1 +(= dbus:DBUS_TYPE_STRING (dbus:dbus_message_iter_get_arg_type *dbus-args*)) T + +(ffi:with-foreign-object (param '(c-array-max character 256)) + (dbus:dbus_message_iter_get_basic *dbus-args* param) + ;; "The name test.method.server was not provided by any .service files" + (stringp (show (ffi:foreign-value param)))) T + +(dbus:dbus_message_iter_next *dbus-args*) 0 ; one argument only + +;; free reply and close connection +(multiple-value-list (dbus:dbus_message_unref *dbus-msg*)) () + +) ;; disable the crashing code + +;; == Receiving a Signal + +;; add a rule for which messages we want to see +(multiple-value-list + (dbus:dbus_bus_add_match *dbus-conn* ; see signals from the given interface + "type='signal',interface='test.signal.Type'" + *dbus-error*)) () +(multiple-value-list (dbus:dbus_connection_flush *dbus-conn*)) () +(dbus:dbus_error_is_set *dbus-error*) 0 ; connection success + +(defun show-message (msg) + (if msg + (format t "~& => ~S (sender ~S) (type ~S) (path ~S) (interface ~S) (member ~S) (error_name ~S) (destination ~S) (signature ~S)~%" + msg (dbus:dbus_message_get_sender msg) + (dbus:dbus_message_get_type msg) + (dbus:dbus_message_get_path msg) + (dbus:dbus_message_get_interface msg) + (dbus:dbus_message_get_member msg) + (dbus:dbus_message_get_error_name msg) + (dbus:dbus_message_get_destination msg) + (dbus:dbus_message_get_signature msg)) + (format t "~& => no message~%")) + msg) +SHOW-MESSAGE + +(defun pop-message (conn) + ;; non blocking read of the next available message + (format t "~&read/write: ~S~%" (dbus:dbus_connection_read_write conn 0)) + (show-message (dbus:dbus_connection_pop_message conn))) +POP-MESSAGE + +;; loop listening for signals being emmitted +(loop :repeat 5 :do + (setq *dbus-msg* (pop-message *dbus-conn*)) + (cond (*dbus-msg* + ;; check if the message is a signal from the correct interface + ;; and with the correct name + (when (= 1 (dbus:dbus_message_is_signal + *dbus-msg* "test.signal.Type" "Test")) + ;; read the parameters + (cond ((= 0 (dbus:dbus_message_iter_init *dbus-msg* *dbus-args*)) + (format t "~& = Message has no arguments!~%")) + ((/= dbus:DBUS_TYPE_STRING + (dbus:dbus_message_iter_get_arg_type *dbus-args*)) + (format t "~& = Argument is not string!~%")) + (t + (ffi:with-foreign-object (param '(c-array-max character 256)) + (dbus:dbus_message_iter_get_basic *dbus-args* param) + (format t "~& = Got Signal with value ~S~%" + (ffi:foreign-value param))))) + ;; free the message + (multiple-value-list (dbus:dbus_message_unref *dbus-msg*)))) + (t ; loop again if we haven't read a message + (sleep 0.1)))) +NIL + +;; == Exposing a Method to be called + +(defun reply-to-method-call (msg conn) + (ffi:with-foreign-object (args 'dbus:DBusMessageIter) + (ffi:with-foreign-object (param 'ffi:c-string) + ;; read the arguments + (cond ((= 0 (dbus:dbus_message_iter_init msg args)) + (format t "~& = Message has no arguments!~%")) + ((/= dbus:DBUS_TYPE_STRING + (dbus:dbus_message_iter_get_arg_type args)) + (format t "~& = Argument is not string!~%")) + (t + (dbus:dbus_message_iter_get_basic args param) + (format t "~& = Method called with ~S~%" + (ffi:foreign-value param))))) + ;; create a reply from the message + (let ((reply (dbus:dbus_message_new_method_return msg))) + ;; add the arguments to the reply + (dbus:dbus_message_iter_init_append reply args) + (ffi:with-foreign-object (stat 'ffi:boolean t) + (when (zerop (dbus:dbus_message_iter_append_basic + args dbus:DBUS_TYPE_BOOLEAN stat)) + (error "Out Of Memory! (stat)"))) + (ffi:with-foreign-object (level 'dbus:dbus_uint32_t 21614) + (when (zerop (dbus:dbus_message_iter_append_basic + args dbus:DBUS_TYPE_UINT32 level)) + (error "Out Of Memory! (level)"))) + ;; send the reply && flush the connection + (multiple-value-bind (status serial) + (dbus:dbus_connection_send conn reply) + (when (zerop status) (error "Out Of Memory! (serial)")) + (format t "~& client_serial=~S~%" serial)) + (dbus:dbus_connection_flush conn) + ;; free the reply + (dbus:dbus_message_unref reply)))) +REPLY-TO-METHOD-CALL + +;; loop, testing for new messages +(loop :repeat 5 :do + (setq *dbus-msg* (pop-message *dbus-conn*)) + (cond (*dbus-msg* + (when (= 1 (dbus_message_is_method_call + *dbus-msg* "test.method.Type" "Method")) + (reply-to-method-call *dbus-msg* *dbus-conn)) + ;; free the message + (multiple-value-list (dbus:dbus_message_unref *dbus-msg*))) + (t (sleep 0.1)))) +NIL + +;; == Requesting a Well-known Name +(= (show dbus:DBUS_REQUEST_NAME_REPLY_PRIMARY_OWNER) + (dbus:dbus_bus_request_name *dbus-conn* "test.method.server" + dbus:DBUS_NAME_FLAG_REPLACE_EXISTING + *dbus-error*)) +T +(dbus:dbus_error_is_set *dbus-error*) 0 ; success + +(progn (ffi:foreign-free *dbus-error*) + (symbol-cleanup '*dbus-error*) + (symbol-cleanup '*dbus-conn*) + (symbol-cleanup '*dbus-msg*) + ;; (ffi:foreign-free *dbus-args*) + (symbol-cleanup '*dbus-args*) + (symbol-cleanup '*dbus-pending*) + ;; (ffi:foreign-free *dbus-param*) + (symbol-cleanup '*dbus-param*) + ) +T ------------------------------ Message: 2 Date: Wed, 20 Aug 2008 19:55:08 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/rawsock test.tst,1.51,1.52 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/modules/rawsock In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv21157/modules/rawsock Modified Files: test.tst Log Message: gethostid --> hostid Index: test.tst =================================================================== RCS file: /cvsroot/clisp/clisp/modules/rawsock/test.tst,v retrieving revision 1.51 retrieving revision 1.52 diff -u -d -r1.51 -r1.52 --- test.tst 30 Jun 2008 14:32:06 -0000 1.51 +++ test.tst 20 Aug 2008 19:55:06 -0000 1.52 @@ -365,9 +365,9 @@ len) 256 -;; os:gethostid sometimes appears to be a mangled IP address -(and (fboundp 'os:gethostid) - (listp (show (cons (rawsock:convert-address :inet (os:gethostid)) +;; os:hostid sometimes appears to be a mangled IP address +(and (fboundp 'os:hostid) + (listp (show (cons (rawsock:convert-address :inet (os:hostid)) (os:hostent-addr-list (os:resolve-host-ipaddr :default)))))) T ------------------------------ Message: 3 Date: Wed, 20 Aug 2008 19:59:54 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/syscalls test.tst,1.77,1.78 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/modules/syscalls In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv22659 Modified Files: test.tst Log Message: sleep after staring tail(1) to give it time to open the file Index: test.tst =================================================================== RCS file: /cvsroot/clisp/clisp/modules/syscalls/test.tst,v retrieving revision 1.77 retrieving revision 1.78 diff -u -d -r1.77 -r1.78 --- test.tst 18 Aug 2008 20:55:26 -0000 1.77 +++ test.tst 20 Aug 2008 19:59:52 -0000 1.78 @@ -414,6 +414,7 @@ (format nil "--pid=~D" (os:process-id))) :output :stream)) + (sleep 1) ; let tail open file (with-open-file (new *tmp1* :direction :output :if-exists :rename-and-delete) (= inode (show (posix:file-stat-ino (posix:file-stat new))))))) ------------------------------ Message: 4 Date: Wed, 20 Aug 2008 21:14:38 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/dbus test.tst,1.2,1.3 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/modules/dbus In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv17953/modules/dbus Modified Files: test.tst Log Message: add ffi: package prefix to c-array-max Index: test.tst =================================================================== RCS file: /cvsroot/clisp/clisp/modules/dbus/test.tst,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- test.tst 20 Aug 2008 19:43:33 -0000 1.2 +++ test.tst 20 Aug 2008 21:14:36 -0000 1.3 @@ -94,7 +94,7 @@ (dbus:dbus_message_iter_init *dbus-msg* *dbus-args*) 1 (= dbus:DBUS_TYPE_STRING (dbus:dbus_message_iter_get_arg_type *dbus-args*)) T -(ffi:with-foreign-object (param '(c-array-max character 256)) +(ffi:with-foreign-object (param '(ffi:c-array-max character 256)) (dbus:dbus_message_iter_get_basic *dbus-args* param) ;; "The name test.method.server was not provided by any .service files" (stringp (show (ffi:foreign-value param)))) T @@ -152,7 +152,8 @@ (dbus:dbus_message_iter_get_arg_type *dbus-args*)) (format t "~& = Argument is not string!~%")) (t - (ffi:with-foreign-object (param '(c-array-max character 256)) + (ffi:with-foreign-object + (param '(ffi:c-array-max character 256)) (dbus:dbus_message_iter_get_basic *dbus-args* param) (format t "~& = Got Signal with value ~S~%" (ffi:foreign-value param))))) ------------------------------ Message: 5 Date: Thu, 21 Aug 2008 15:45:54 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.6483,1.6484 lispbibl.d,1.811,1.812 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv5910/src Modified Files: ChangeLog lispbibl.d Log Message: (I_to_ulong, I_to_slong): define regardless of HAVE_FFI for the sake of the syscalls module Index: lispbibl.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v retrieving revision 1.811 retrieving revision 1.812 diff -u -d -r1.811 -r1.812 --- lispbibl.d 5 Aug 2008 22:36:40 -0000 1.811 +++ lispbibl.d 21 Aug 2008 15:45:51 -0000 1.812 @@ -16347,14 +16347,12 @@ #define I_to_uint I_to_uint32 #define I_to_sint I_to_sint32 #endif -#if defined(HAVE_FFI) - #if (long_bitsize==32) - #define I_to_ulong I_to_uint32 - #define I_to_slong I_to_sint32 - #else /* (long_bitsize==64) */ - #define I_to_ulong I_to_uint64 - #define I_to_slong I_to_sint64 - #endif +#if (long_bitsize==32) + #define I_to_ulong I_to_uint32 + #define I_to_slong I_to_sint32 +#else /* (long_bitsize==64) */ + #define I_to_ulong I_to_uint64 + #define I_to_slong I_to_sint64 #endif /* used by FFI, STREAM, modules */ %% export_def(I_to_uint8(obj)); Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6483 retrieving revision 1.6484 diff -u -d -r1.6483 -r1.6484 --- ChangeLog 20 Aug 2008 18:52:21 -0000 1.6483 +++ ChangeLog 21 Aug 2008 15:45:49 -0000 1.6484 @@ -1,5 +1,10 @@ 2008-08-20 Sam Steingold <sd...@gn...> + * lispbibl.d (I_to_ulong, I_to_slong): define regardless of HAVE_FFI + for the sake of the syscalls module + +2008-08-20 Sam Steingold <sd...@gn...> + * modules/dbus/configure.in (dbus_int64_t, dbus_int32_t, dbus_uint32_t) (dbus_int16_t, dbus_unichar_t, dbus_bool_t): check types * modules/dbus/dbus.lisp (def-c-const): import from EXPORTING; ------------------------------ Message: 6 Date: Thu, 21 Aug 2008 15:52:17 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.6484,1.6485 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv8458/src Modified Files: ChangeLog Log Message: (%SETHOSTID): sethostid does not return a value on *BSD, use errno to check for errors Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6484 retrieving revision 1.6485 diff -u -d -r1.6484 -r1.6485 --- ChangeLog 21 Aug 2008 15:45:49 -0000 1.6484 +++ ChangeLog 21 Aug 2008 15:52:14 -0000 1.6485 @@ -1,7 +1,10 @@ 2008-08-20 Sam Steingold <sd...@gn...> - * lispbibl.d (I_to_ulong, I_to_slong): define regardless of HAVE_FFI - for the sake of the syscalls module + * lispbibl.d (I_to_ulong, I_to_slong): define regardless of + HAVE_FFI for the sake of the syscalls module + * modules/syscalls/calls.c (%SETHOSTID): sethostid does not return + a value on *BSD, use errno to check for errors + Reported by José H. Espinosa <jos...@gm...> 2008-08-20 Sam Steingold <sd...@gn...> ------------------------------ Message: 7 Date: Thu, 21 Aug 2008 15:52:16 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/syscalls calls.c,1.248,1.249 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/modules/syscalls In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv8458/modules/syscalls Modified Files: calls.c Log Message: (%SETHOSTID): sethostid does not return a value on *BSD, use errno to check for errors Index: calls.c =================================================================== RCS file: /cvsroot/clisp/clisp/modules/syscalls/calls.c,v retrieving revision 1.248 retrieving revision 1.249 diff -u -d -r1.248 -r1.249 --- calls.c 18 Aug 2008 18:53:18 -0000 1.248 +++ calls.c 21 Aug 2008 15:52:14 -0000 1.249 @@ -1774,7 +1774,13 @@ #endif #if defined(HAVE_SETHOSTID) #define I_to_hid(x) I_to_ulong(check_ulong(x)) -DEFUN(POSIX::%SETHOSTID, hostid) { SETTER(unsigned long,I_to_hid,sethostid); } +DEFUN(POSIX::%SETHOSTID, hostid) { + unsigned long hid = I_to_ulong(check_ulong(STACK_0 = STACK_0)); + int e; + begin_system_call(); errno = 0; sethostid(hid); e = errno; end_system_call(); + if (e) OS_error(); + VALUES1(popSTACK()); +} #endif #if defined(HAVE_FSTAT) && defined(HAVE_STAT) ------------------------------ Message: 8 Date: Thu, 21 Aug 2008 18:57:18 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.6485,1.6486 foreign.d,1.186,1.187 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv10213/src Modified Files: ChangeLog foreign.d Log Message: (foreign_with_pointers_p): support inttypes (return false) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6485 retrieving revision 1.6486 diff -u -d -r1.6485 -r1.6486 --- ChangeLog 21 Aug 2008 15:52:14 -0000 1.6485 +++ ChangeLog 21 Aug 2008 18:57:16 -0000 1.6486 @@ -1,3 +1,7 @@ +2008-08-21 Sam Steingold <sd...@gn...> + + * foreign.d (foreign_with_pointers_p): support inttypes (return false) + 2008-08-20 Sam Steingold <sd...@gn...> * lispbibl.d (I_to_ulong, I_to_slong): define regardless of Index: foreign.d =================================================================== RCS file: /cvsroot/clisp/clisp/src/foreign.d,v retrieving revision 1.186 retrieving revision 1.187 diff -u -d -r1.186 -r1.187 --- foreign.d 10 Jul 2008 16:12:46 -0000 1.186 +++ foreign.d 21 Aug 2008 18:57:16 -0000 1.187 @@ -1463,6 +1463,8 @@ if (eq(fvd,S(c_string))) return true; return false; + } else if (stringp(fvd)) { + return false; /* inttype */ } else if (simple_vector_p(fvd)) { var uintL fvdlen = Svector_length(fvd); if (fvdlen > 0) { ------------------------------ Message: 9 Date: Thu, 21 Aug 2008 18:59:52 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src ChangeLog,1.6486,1.6487 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv10600/src Modified Files: ChangeLog Log Message: (DBusMessageIter): c-struct, not c-pointer Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.6486 retrieving revision 1.6487 diff -u -d -r1.6486 -r1.6487 --- ChangeLog 21 Aug 2008 18:57:16 -0000 1.6486 +++ ChangeLog 21 Aug 2008 18:59:50 -0000 1.6487 @@ -1,5 +1,9 @@ 2008-08-21 Sam Steingold <sd...@gn...> + * modules/dbus/dbus.lisp (DBusMessageIter): c-struct, not c-pointer + +2008-08-21 Sam Steingold <sd...@gn...> + * foreign.d (foreign_with_pointers_p): support inttypes (return false) 2008-08-20 Sam Steingold <sd...@gn...> ------------------------------ Message: 10 Date: Thu, 21 Aug 2008 18:59:52 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/dbus dbus.lisp,1.7,1.8 test.tst,1.3,1.4 To: cli...@li... Message-ID: <E1K...@ma...> Update of /cvsroot/clisp/clisp/modules/dbus In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv10600/modules/dbus Modified Files: dbus.lisp test.tst Log Message: (DBusMessageIter): c-struct, not c-pointer Index: dbus.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/modules/dbus/dbus.lisp,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- dbus.lisp 20 Aug 2008 18:52:21 -0000 1.7 +++ dbus.lisp 21 Aug 2008 18:59:49 -0000 1.8 @@ -147,7 +147,22 @@ ;; needs to be freed and can be allocated on the stack. ;; typedef struct DBusMessageIter DBusMessageIter; (def-c-type DBusMessage* c-pointer) -(def-c-type DBusMessageIter c-pointer) +(def-c-type DBusMessageIter (c-struct DBusMessageIter + (dummy1 c-pointer) ; Don't use this + (dummy2 c-pointer) ; Don't use this + (dummy3 dbus_uint32_t) ; Don't use this + (dummy4 int) ; Don't use this + (dummy5 int) ; Don't use this + (dummy6 int) ; Don't use this + (dummy7 int) ; Don't use this + (dummy8 int) ; Don't use this + (dummy9 int) ; Don't use this + (dummy10 int) ; Don't use this + (dummy11 int) ; Don't use this + (pad1 int) ; Don't use this + (pad2 int) ; Don't use this + (pad3 c-pointer) ; Don't use this + )) (def-c-type DBusMessageIter* (c-pointer DBusMessageIter)) ;; DBusMessage* dbus_message_new (int message_type); Index: test.tst =================================================================== RCS file: /cvsroot/clisp/clisp/modules/dbus/test.tst,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- test.tst 20 Aug 2008 21:14:36 -0000 1.3 +++ test.tst 21 Aug 2008 18:59:49 -0000 1.4 @@ -22,6 +22,12 @@ (null *dbus-conn*) NIL (dbus:dbus_error_is_set *dbus-error*) 0 ; connection success +(defparameter *dbus-iter* (show (ffi:allocate-shallow 'dbus:DBusMessageIter))) +*DBUS-ITER* +(defparameter *dbus-args* + (show (ffi:c-var-address (ffi:foreign-value *dbus-iter*)))) +*DBUS-ARGS* + ;; == Sending a Signal (defparameter *dbus-msg* ; create a signal (dbus:dbus_message_new_signal @@ -31,6 +37,13 @@ *DBUS-MSG* (null *dbus-msg*) NIL +;; append arguments +(multiple-value-list + (dbus:dbus_message_iter_init_append *dbus-msg* *dbus-args*)) () +(ffi:with-foreign-object (param 'dbus:dbus_uint32_t 123) + (dbus:dbus_message_iter_append_basic + *dbus-args* dbus:DBUS_TYPE_UINT32 param)) 1 + ;; send the message and flush the connection (multiple-value-list (dbus:dbus_connection_send *dbus-conn* *dbus-msg*)) (1 2) (multiple-value-list (dbus:dbus_connection_flush *dbus-conn*)) () @@ -38,7 +51,6 @@ (multiple-value-list (dbus:dbus_message_unref *dbus-msg*)) () ;; == Calling a Method -#+(or) (progn ; crash in dbus_connection_send_with_reply (defparameter *dbus-msg* (dbus:dbus_message_new_method_call "test.method.server" ; target for the method call @@ -48,22 +60,12 @@ *DBUS-MSG* (null *dbus-msg*) NIL -(defparameter *dbus-args* (ffi:allocate-shallow 'dbus:DBusMessageIter)) -*DBUS-ARGS* -(defparameter *dbus-param* - (ffi:allocate-deep '(ffi:c-array-max character 256) "abazonk")) -*DBUS-PARAM* -(defparameter *dbus-param-addr* - (ffi:allocate-deep 'ffi:c-pointer - (ffi:c-var-address (ffi:foreign-value *dbus-param*)))) -*DBUS-PARAM-ADDR* - ;; append arguments (multiple-value-list (dbus:dbus_message_iter_init_append *dbus-msg* *dbus-args*)) () -(dbus:dbus_message_iter_append_basic - *dbus-args* dbus:DBUS_TYPE_STRING *dbus-param-addr*) -1 +(ffi:with-foreign-object (param 'ffi:c-string "abazonk") + (dbus:dbus_message_iter_append_basic + *dbus-args* dbus:DBUS_TYPE_STRING param)) 1 (defparameter *dbus-pending* (multiple-value-bind (status pending) @@ -83,9 +85,7 @@ (multiple-value-list (dbus:dbus_pending_call_block *dbus-pending*)) () ;; get the reply message -(defparameter *dbus-msg* (dbus:dbus_pending_call_steal_reply *dbus-pending*)) -*DBUS-MSG* -(null *dbus-msg*) NIL +(null (setq *dbus-msg* (dbus:dbus_pending_call_steal_reply *dbus-pending*))) NIL ;; free the pending message handle (multiple-value-list (dbus:dbus_pending_call_unref *dbus-pending*)) () @@ -104,8 +104,6 @@ ;; free reply and close connection (multiple-value-list (dbus:dbus_message_unref *dbus-msg*)) () -) ;; disable the crashing code - ;; == Receiving a Signal ;; add a rule for which messages we want to see @@ -224,10 +222,9 @@ (symbol-cleanup '*dbus-error*) (symbol-cleanup '*dbus-conn*) (symbol-cleanup '*dbus-msg*) - ;; (ffi:foreign-free *dbus-args*) + (ffi:foreign-free *dbus-iter*) + (symbol-cleanup '*dbus-iter*) (symbol-cleanup '*dbus-args*) (symbol-cleanup '*dbus-pending*) - ;; (ffi:foreign-free *dbus-param*) - (symbol-cleanup '*dbus-param*) ) T ------------------------------ ------------------------------------------------------------------------- This SF.Net email is sponsored by the Moblin Your Move Developer's challenge Build the coolest Linux based applications with Moblin SDK & win great prizes Grand prize is a trip for two to an Open Source event anywhere in the world http://moblin-contest.org/redirect.php?banner_id=100&url=/ ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 28, Issue 23 ***************************************** |