anchor.diff:         ',name)))
   
   
  -(defun pack (object type)
  +(defun pack (object type &key footer)
     "Make a packet buffer from the initial object."
  -  (let ((buffer (make-array (type-size type) 
  -							:element-type '(unsigned-byte 8)
  -							:initial-element 0)))
  -    (pack-type object type buffer 0)
  -    buffer))
  +  (let ((flen (length footer))
  +        (tsize (type-size type)))
  +
  +    (unless tsize
  +      (error "Type ~S not found" type))
  +
  +    ;; if its a string type then allocate a buffer to put it in
  +    (case type
  +      (:string (setf tsize (length object)))
  +      (:wstring (setf tsize (* 2 (length object)))))      
  +
  +    (let ((buffer (make-array (+ tsize flen)
  +                              :element-type '(unsigned-byte 8)
  +                              :initial-element 0)))
  +
  +      ;; another horrible hack...
  +      (case type
  +        (:string (pack-string object (length object) buffer 0))
  +        (:wstring (pack-wstring object (length object) buffer 0))
  +        (otherwise 
  +         ;; pack the static object
  +         (pack-type object type buffer 0)))
  +
  +      ;; append the binary footer if provided
  +      (when footer
  +        (loop for i below flen do
  +             (setf (elt buffer (+ tsize i))
  +                   (elt footer i))))
  +
  +      ;; return buffer
  +      buffer)))
   
   (defun unpack (buffer type)
  -  "Unpack a buffer into an object."
  +  "Unpack a buffer into an object. Returns any extra (unused) bytes as the 2nd value"
     (let ((len (length buffer))
   		(size (type-size type)))
  -	(if (<= len size)
  -		(unpack-type type buffer 0)
  -		(error "Buffer length ~S is smaller than ~S size ~S."
  -			   len type size))))
  -
  +	(when (> size len)
  +      (error "Buffer length ~S is smaller than ~S size ~S."
  +             len type size))
  +
  +    (let (val extra)
  +      (case type
  +        (:string (setf val (unpack-string len buffer 0)
  +                       extra (subseq buffer len)))
  +        (:wstring (setf val (unpack-wstring (/ len 2) buffer 0)
  +                        extra (subseq buffer len)))
  +        (otherwise (setf val (unpack-type type buffer 0)
  +                          extra (subseq buffer size))))
  +      (values val extra))))
  +                          
  +
  +
  +          
  
positive.code: ;; the actual packing/unpacking is done by some special code in the closures
  ;; generated by %define-packet-type. There MUST be a better way of doing it!!!
  (define-alias :string :uint8)
  
  ;; it'd be nicer if we could just define :string as a packet type, but this isn't possible.
  ;; maybe we need to be able to define array types?
  
negative.code: 			(if (zerop code)
  				(return-from extract-string)
  				(princ (code-char code) s))))))))
  
  (defun pack-wstring (string length buffer start)
    "Pack a string into the buffer."
    (let ((array (make-array length))
          (len (length string)))
      (dotimes (i length)
        (if (< i len)
  		  (setf (elt array i) (char-code (char string i)))
  		  (setf (elt array i) 0)))
      (pack-array array
  				:uint16
  				buffer
  				start)))
  
  (defun unpack-wstring (length buffer start)
    "Unpack a string from the buffer."
    (let ((bytes (unpack-array length :uint16 buffer start)))
      (with-output-to-string (s)
        (block extract-string
  		(dotimes (i (length bytes))
  		  (let ((code (elt bytes i)))
  			(if (zerop code)
  				(return-from extract-string)
  				(princ (code-char code) s))))))))
  
  
  
  ;; --------------------- packets / structures --------------------------
  
  