Function: bindat--unpack-group

bindat--unpack-group is a byte-compiled function defined in bindat.el.gz.

Signature

(bindat--unpack-group SPEC)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/bindat.el.gz
  (* len (/ (+ n (1- len)) len)))       ;Isn't there a simpler way?

(defun bindat--unpack-group (spec)
  ;; FIXME: Introduce a new primitive so we can mark `bindat-unpack'
  ;; as obsolete (maybe that primitive should be a macro which takes
  ;; a bindat type *expression* as argument).
  (if (cl-typep spec 'bindat--type)
      (funcall (bindat--type-ue spec))
  (with-suppressed-warnings ((lexical struct last))
    (defvar struct) (defvar last))
  (let (struct last)
    (dolist (item spec)
      (let* ((field (car item))
	     (type (nth 1 item))
	     (len (nth 2 item))
	     (vectype (and (eq type 'vec) (nth 3 item)))
	     (tail 3)
	     data)
	(if (and type (consp type) (eq (car type) 'eval))
	    (setq type (eval (car (cdr type)) t)))
	(if (and len (consp len) (eq (car len) 'eval))
	    (setq len (eval (car (cdr len)) t)))
	(if (memq field '(eval fill align struct union))
	    (setq tail 2
		  len type
		  type field
		  field nil))
	(if (and (consp field) (eq (car field) 'eval))
	    (setq field (eval (car (cdr field)) t)))
	(if (and (consp len) (not (eq type 'eval)))
            (setq len (apply #'bindat-get-field struct len)))
	(if (not len)
	    (setq len 1))
	(pcase type
	 ('eval
	  (if field
	      (setq data (eval len t))
	    (eval len t)))
	 ('fill
	  (setq bindat-idx (+ bindat-idx len)))
	 ('align
	  (setq bindat-idx (bindat--align bindat-idx len)))
	 ('struct
	  (setq data (bindat--unpack-group (eval len t))))
	 ('repeat
	  (dotimes (_ len)
	    (push (bindat--unpack-group (nthcdr tail item)) data))
	  (setq data (nreverse data)))
	 ('union
	  (with-suppressed-warnings ((lexical tag))
	    (defvar tag))
	  (let ((tag len) (cases (nthcdr tail item)) case cc)
	    (while cases
	      (setq case (car cases)
		    cases (cdr cases)
		    cc (car case))
	      (if (or (equal cc tag) (equal cc t)
		      (and (consp cc) (eval cc t)))
		  (setq data (bindat--unpack-group (cdr case))
			cases nil)))))
	 ((pred integerp) (debug t))
	 (_
	  (setq data (bindat--unpack-item type len vectype)
		last data)))
	(if data
	    (setq struct (if field
                             (cons (cons field data) struct)
                           (append data struct))))))
    struct)))