(in-package :fwoar.cl-git) (defmacro defclass+ (name (&rest super) &body (direct-slots &rest options)) (let ((initargs (mapcan (lambda (slot) (serapeum:unsplice (make-symbol (symbol-name (getf (cdr slot) :initarg))))) direct-slots))) `(progn (defclass ,name ,super ,direct-slots ,@options) (defun ,name (,@initargs) (fw.lu:new ',name ,@initargs))))) (fw.lu:defun-ct batch-4 (bytes) (mapcar 'fwoar.bin-parser:be->int (serapeum:batches bytes 4))) (fw.lu:defun-ct batch-20 (bytes) (serapeum:batches bytes 20)) (defmacro sym->plist (&rest syms) `(list ,@(loop for sym in syms append (list (alexandria:make-keyword sym) sym)))) (defmacro inspect- (s form) `(let ((result ,form)) (format ,s "~&~s (~{~s~^ ~})~%~4t~s~%" ',form ,(typecase form (list `(list ',(car form) ,@(cdr form))) (t `(list ,form))) result) result)) (defun inspect-* (fn) (lambda (&rest args) (declare (dynamic-extent args)) (inspect- *trace-output* (apply fn args)))) (defun partition (char string &key from-end (with-offset nil wo-p)) (let ((pos (position char string :from-end from-end))) (if pos (if wo-p (list (subseq string 0 (+ pos with-offset 1)) (subseq string (+ pos 1 with-offset))) (list (subseq string 0 pos) (subseq string (1+ pos)))) (list string nil)))) (defun partition-subseq (subseq string &key from-end) (let ((pos (search subseq string :from-end from-end))) (if pos (list (subseq string 0 pos) (subseq string (+ (length subseq) pos))) (list string nil)))) (serapeum:defalias ->sha-string (data-lens:<>1 (data-lens:over 'fwoar.bin-parser:byte-array-to-hex-string) 'batch-20)) (defun read-bytes (count format stream) (let ((seq (make-array count :element-type 'fwoar.cl-git.types:octet))) (read-sequence seq stream) (funcall format seq))) (defun sp-ob (ob-string) (partition #\null ob-string)) (defun split-object (object-data) (destructuring-bind (head tail) (partition 0 object-data) (destructuring-bind (type length) (partition #\space (babel:octets-to-string head :encoding :latin1)) (values tail (list type (parse-integer length)))))) (defmacro with-open-files* ((&rest bindings) &body body) `(uiop:nest ,@(mapcar (serapeum:op `(with-open-file ,_1)) bindings) (progn ,@body)))