X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=lsp-misc%2Fmisc.lsp;h=ff76d5a294b8dfd6b3e1da5e3e3669d4ae8d1429;hb=12b8b31df1918875f91a1830743a23004f373466;hp=cf92d9cb2b110469ed163a381daef0d2d375c1cb;hpb=1898ef96b70cb93c53a84e6a7536d0a3bceb35d6;p=rrq%2Flsp-utils.git diff --git a/lsp-misc/misc.lsp b/lsp-misc/misc.lsp index cf92d9c..ff76d5a 100644 --- a/lsp-misc/misc.lsp +++ b/lsp-misc/misc.lsp @@ -1,16 +1,48 @@ +;; This module provides some global utility functions. + (define (prog1 X) X) (global 'prog1) (define (die N) (when (args) (write-line 2 (join (map string (args)) " "))) - (exit N)) + (and N (exit N))) (global 'die) +;; Prepend with C onto S so as to fill width W, if it's a number. +(define (pre-fill C S W) + (if (and (number? W) (> (setf W (- W (length S))))) (string (dup C W) S) S)) +(global 'pre-fill) + +;; Make a hex string from a data block pad with "0" to W if non-nil +(define (char2hex STR W) + (pre-fill "0" (join (map (curry format "%2x") (map char (explode STR)))) W)) +(global 'char2hex) + ;; Print binary byte as octal or as ASCII character [32-126] (define (octal-byte x) (if (and (> x 31) (< x 127)) (char x) (format "\\%o" x))) +(global 'octal-byte) ;; Print string as binary octals (define (octals-string S) - (join (map octal-byte (unpack (dup "b" (length S)) S))) "") -(global 'octals-string 'octal-byte) + (join (map octal-byte (unpack (dup "b" (length S)) S)))) +(global 'octals-string) + +;; Return byte code as printable or as decimal number. +(define (human-byte B) + (if (and (> B 32) (< B 127)) (char B) B)) +(global 'human-byte) + +;; Return a packed encoding of a list of bytes, joining its string elements +(define (human-bytes BL) + (let ((OUT '()) (X nil)) + (dolist (B (map human-byte BL)) + (if (string? B) (if X (extend X B) (setf X B)) + (begin (when (string? X) (push X OUT -1)) + (push B OUT -1) + (setf X nil)))) + (when (string? X) (push X OUT -1)) + OUT)) +(global 'human-bytes) + +"misc.lsp"