Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 94 lines (75 sloc) 3.183 kB
e33233c @blitz Round one at new marshalling framework. Not done yet.
authored
1 ;;; -*- Mode: Lisp -*-
2 ;;; Copyright (c) 2008 Julian Stecklina
3 ;;;
4 ;;; This file is part of CL-DBUS. Look into LICENSE for license terms.
5
6 (in-package :blitz.desktop.dbus)
7
a114191 @blitz Not sure how to handle types in a generic way...
authored
8 (defvar *name-to-type* (make-hash-table))
e33233c @blitz Round one at new marshalling framework. Not done yet.
authored
9
a114191 @blitz Not sure how to handle types in a generic way...
authored
10 (defstruct dbus-type
11 name char alignment)
12
13 (defmethod print-object ((o dbus-type) s)
14 (if *print-readably*
15 (call-next-method)
16 (print-unreadable-object (o s :type t :identity nil)
17 (format s "~A(~A)" (dbus-type-name o) (dbus-type-alignment o)))))
e33233c @blitz Round one at new marshalling framework. Not done yet.
authored
18
19 (eval-when (:load-toplevel :compile-toplevel :execute)
a114191 @blitz Not sure how to handle types in a generic way...
authored
20 (defmacro define-dbus-type (name type-char alignment)
21 `(setf (gethash ',type-char *name-to-type*)
22 (make-dbus-type :name ',name
23 :char ',type-char
24 :alignment ',alignment))))
e33233c @blitz Round one at new marshalling framework. Not done yet.
authored
25
26 (define-dbus-type boolean #\b 4)
27
28 (define-dbus-type uint8 #\y 1)
29 (define-dbus-type int16 #\n 2)
30 (define-dbus-type uint16 #\q 2)
31 (define-dbus-type int32 #\i 4)
32 (define-dbus-type uint32 #\u 4)
33 (define-dbus-type int64 #\x 8)
34 (define-dbus-type uint64 #\t 8)
35 (define-dbus-type double #\d 8)
36
37 (define-dbus-type string #\s 4)
38 (define-dbus-type signature #\g 1)
39 (define-dbus-type object-path #\o 4)
40
41 (define-dbus-type variant #\v 1)
42
a114191 @blitz Not sure how to handle types in a generic way...
authored
43 ;; (define-dbus-type struct #\r 8 dbus-compound-type)
44 ;; (define-dbus-type array #\a 4 dbus-compound-type)
45 ;; (define-dbus-type dict-entry #\e 8 dbus-compound-type)
e33233c @blitz Round one at new marshalling framework. Not done yet.
authored
46
47 (defgeneric marshall (type object vector start)
48 (:documentation "Marshalls OBJECT (interpreted as TYPE) into
49 VECTOR (starting at START). Returns VECTOR and an index pointing
2c69b47 @blitz Commented out a lot of old code that is to be replaced.
authored
50 after the written data. VECTOR is destructively modified!"))
e33233c @blitz Round one at new marshalling framework. Not done yet.
authored
51
2c69b47 @blitz Commented out a lot of old code that is to be replaced.
authored
52 (defun dbus-write-byte (vector byte start &optional (repeat 1))
53 "Writes BYTE REPEAT-times into VECTOR starting at START. Returns the
54 new position in VECTOR."
e33233c @blitz Round one at new marshalling framework. Not done yet.
authored
55 (iter (repeat repeat)
56 (for i upfrom 0)
2c69b47 @blitz Commented out a lot of old code that is to be replaced.
authored
57 (setf (aref vector (+ start i)) byte))
58 (+ start repeat))
59
60 (defun dbus-write-sequence (destination source start)
61 "Writes SOURCE into DESTINATION (both vectors) starting at
62 START. Returns the new position in DESTINATION."
63 (when (> (+ (length source) start)
64 (length destination))
65 (error "Vector too small."))
66 (setf (subseq destination start) source)
67 (+ start (length source)))
e33233c @blitz Round one at new marshalling framework. Not done yet.
authored
68
a114191 @blitz Not sure how to handle types in a generic way...
authored
69 ;; (defmethod marshall :around ((type dbus-type) object vector start)
70 ;; ;; Alignment is handled in this around method.
71 ;; (let* ((alignment (alignment-of type))
72 ;; (mod (nth-value 1 (truncate start alignment))))
73 ;; (format t "~A ~A~%" alignment mod)
74 ;; (values
75 ;; (call-next-method type object vector
76 ;; (dbus-write-byte vector 0 start
77 ;; (mod (- alignment mod) alignment)))
78 ;; vector)))
79
80 ;; (defmethod marshall ((type dbus-boolean) object vector start)
81 ;; (dbus-write-sequence vector
82 ;; (if object
83 ;; #+ little-endian #(1 0 0 0)
84 ;; #+ big-endian #(0 0 0 1)
85 ;; #(0 0 0 0))
86 ;; start))
87
88 ;;; TODO Parse signature string into list of dbus-type structures.
89 ;;; How to represent arrays and structs?
90
91 ;;; TODO
2c69b47 @blitz Commented out a lot of old code that is to be replaced.
authored
92
e33233c @blitz Round one at new marshalling framework. Not done yet.
authored
93 ;;; EOF
Something went wrong with that request. Please try again.