Skip to content
Newer
Older
100644 52 lines (40 sloc) 1.68 KB
a861a97 @blitz Reorganized the source a little bit.
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
8 (defun read-line-crlf (stream)
9 "Read a line terminated with a CR/LF pair."
10 (let ((line (read-line stream)))
11 (assert (char= #\Return
12 (char line (1- (length line)))))
13 ;; Using displaced arrays instead of subseq does not seem to offer
14 ;; any advantages on SBCL.
15 (subseq line 0 (1- (length line)))))
16
17 (defun format-crlf (stream fmt &rest args)
18 (format stream "~?~C~C" fmt args #\Return #\Newline))
19
20 (defun octets-to-hex-string (octets)
21 (string-downcase (format nil "~{~2,'0X~}" (coerce octets 'list))))
22
23 (defun string-to-hex-string (string)
98ef247 @ilitirit removed dependency on sbcl and added dependency on babel; should be p…
ilitirit authored
24 (octets-to-hex-string (babel:string-to-octets string :encoding :ascii)))
a861a97 @blitz Reorganized the source a little bit.
authored
25
26 ;;; Hex string handling
27
28 (defun read-line-and-split (stream)
29 (cl-ppcre:split "\\s" (read-line-crlf stream)))
30
31 (defun parse-hex-string (string)
32 (declare (type string string))
33 (assert (evenp (length string)))
34 (iter (with output = (make-array (truncate (length string) 2)
35 :element-type '(unsigned-byte 8)))
36 (for out-pos from 0 below (truncate (length string) 2))
37 (declare (type fixnum out-pos))
38 (flet ((dc (index)
39 (let ((c (digit-char-p (char string index) 16)))
40 (or c
41 (error "Bogus string")))))
42 (declare (inline dc))
43 (setf (aref output out-pos)
44 (logand #xFF
45 (logior (ash (dc (* out-pos 2)) 4)
46 (dc (1+ (* out-pos 2)))))))
47 (finally (return output)) ))
48
49 ;;; EOF
98ef247 @ilitirit removed dependency on sbcl and added dependency on babel; should be p…
ilitirit authored
50
51
Something went wrong with that request. Please try again.