projects
/
rrq
/
lsp-utils.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
expanded documentation
[rrq/lsp-utils.git]
/
lsp-dbus
/
lsp-dbus-marshal.lsp
diff --git
a/lsp-dbus/lsp-dbus-marshal.lsp
b/lsp-dbus/lsp-dbus-marshal.lsp
index 02859d6f006a2f4d7f314521a23bee1d8a428e92..90db86e5cc6c8d14b71e06051f2b53d8a7efaeca 100644
(file)
--- a/
lsp-dbus/lsp-dbus-marshal.lsp
+++ b/
lsp-dbus/lsp-dbus-marshal.lsp
@@
-15,6
+15,7
@@
; Ex: "a(yi)" = (("a" ("y" "i")))
; Ex: "yyyyuua(yv)" = ("y" "y" "y" "y" "u" "u" ("a" ("y" "v")))
(define (expand-signature S)
; 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
(let ((STACK '()) (CUR '()) (A 0))
(dolist (X (explode S))
(case X
@@
-49,7
+50,7
@@
(constant
'FMTMAP ; mapping dbus type code to byte size and newlisp code
'( ("y" 1 "b") ; BYTE (unsigned 8-bit integer)
(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)
("n" 2 "d") ; INT16 (signed 16-bit integer)
("q" 2 "u") ; UINT16 (unsigned 16-bit integer)
("i" 4 "ld") ; INT32 (signed 32-bit integer)
@@
-144,9
+145,7
@@
;; and followed by a NUL byte. The subsequent data is unpacked
;; according to that type character.
(define (unpack-data-variant)
;; 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.
;; Unpack the ES type item from (AT DATA), optionally with
;; pre-alignment, and increment AT past the padding and item.
@@
-163,6
+162,7
@@
;; elements.
(define (unpack-data-array ES)
(let ((A AT) (N (+ (unpack-align 4 "u") AT)) (OUT '()))
;; 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 (< AT N)
(push (unpack-data-item ES) OUT -1))
OUT))
@@
-195,7
+195,7
@@
(dotimes (i (length M 0))
(setf (M i 0) (MESSAGE-HEADERS (M i 0) 0)))
;; Add the body, if any, keyed by "".
(dotimes (i (length M 0))
(setf (M i 0) (MESSAGE-HEADERS (M i 0) 0)))
;; Add the body, if any, keyed by "".
- (setf S (if (lookup 'SIGNATURE M)
($it 0)
""))
+ (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)))))
(when (and (!= S "") (setf D (unpack-data S DATA AT)))
(setf AT (D 1))
(extend M (list (list "" (D 0)))))