; Ex: "a(yi)" = (("a" ("y" "i")))
; Ex: "yyyyuua(yv)" = ("y" "y" "y" "y" "u" "u" ("a" ("y" "v")))
(define (expand-signature S)
+ (setf S (replace "{" (replace "}" (copy S) ")") "("))
(let ((STACK '()) (CUR '()) (A 0))
(dolist (X (explode S))
(case X
(constant
'FMTMAP ; mapping dbus type code to byte size and newlisp code
'( ("y" 1 "b") ; BYTE (unsigned 8-bit integer)
- ("b" 1 "b") ; BOOLEAN (0 is FALSE, 1 is TRUE, else invalid)
+ ("b" 4 "lu") ; BOOLEAN (0 is FALSE, 1 is TRUE, else invalid)
("n" 2 "d") ; INT16 (signed 16-bit integer)
("q" 2 "u") ; UINT16 (unsigned 16-bit integer)
("i" 4 "ld") ; INT32 (signed 32-bit integer)
;; and followed by a NUL byte. The subsequent data is unpacked
;; according to that type character.
(define (unpack-data-variant)
- (let ((ES ((unpack "bs1b" (AT DATA)) 1)))
- (inc AT 3)
- (unpack-data-item ES)))
+ (unpack-data-item ((expand-signature (unpack-data-signature "g")) 0)))
;; Unpack the ES type item from (AT DATA), optionally with
;; pre-alignment, and increment AT past the padding and item.
;; elements.
(define (unpack-data-array ES)
(let ((A AT) (N (+ (unpack-align 4 "u") AT)) (OUT '()))
+ (when (and (list? ES) (!= "a" (ES 0))) (align-AT 8))
(while (< AT N)
(push (unpack-data-item ES) OUT -1))
OUT))
(while (and (< AT (length DATA))
(setf M (unpack-data "yyyyuua(yv)" DATA AT)))
(setf AT (M 1))
- (setf M (M 0 -1)) ; Drop
+ (setf M (M 0 -1)) ; Drop all but the headers then map to symbol keys
(dotimes (i (length M 0))
(setf (M i 0) (MESSAGE-HEADERS (M i 0) 0)))
- (setf S (if (lookup 'SIGNATURE M) ($it 0) ""))
+ ;; Add the body, if any, keyed by "".
+ (setf S (if (lookup 'SIGNATURE M) $it ""))
(when (and (!= S "") (setf D (unpack-data S DATA AT)))
(setf AT (D 1))
(extend M (list (list "" (D 0)))))
- (push M OUT -1)
+ ;; Collate message and move to the next portion in DATA
+ (push M OUT -1)
(setf DATA (AT DATA))
(setf AT 0)
)
OUT ))
+
+"lsp-dbus-marshal.lsp"