lsp-misc/misc.lsp

   1 ;; This module provides some global utility functions.
   2
   3 (define (prog1 X) X)
   4 (global 'prog1)
   5
   6 (define (die N)
   7   (when (args) (write-line 2 (join (map string (args)) " ")))
   8   (and N (exit N)))
   9 (global 'die)
  10
  11 ;; Prepend with C onto S so as to fill width W, if it's a number.
  12 (define (pre-fill C S W)
  13   (if (and (number? W) (> (setf W (- W (length S))))) (string (dup C W) S) S))
  14 (global 'pre-fill)
  15
  16 ;; Make a hex string from a data block pad with "0" to W if non-nil
  17 (define (char2hex STR W)
  18   (pre-fill "0" (join (map (curry format "%2x") (map char (explode STR)))) W))
  19 (global 'char2hex)
  20
  21 ;; Print binary byte as octal or as ASCII character [32-126]
  22 (define (octal-byte x)
  23   (if (and (> x 31) (< x 127)) (char x) (format "\\%o" x)))
  24 (global 'octal-byte)
  25
  26 ;; Print string as binary octals
  27 (define (octals-string S)
  28   (join (map octal-byte (unpack (dup "b" (length S)) S))))
  29 (global 'octals-string)
  30
  31 ;; Return byte code as printable or as decimal number.
  32 (define (human-byte B)
  33   (if (and (> B 32) (< B 127)) (char B) B))
  34 (global 'human-byte)
  35
  36 ;; Return a packed encoding of a list of bytes, joining its string elements
  37 (define (human-bytes BL)
  38   (let ((OUT '()) (X nil))
  39     (dolist (B (map human-byte BL))
  40       (if (string? B) (if X (extend X B) (setf X B))
  41         (begin (when (string? X) (push X OUT -1))
  42              (push B OUT -1)
  43              (setf X nil))))
  44     (when (string? X) (push X OUT -1))
  45     OUT))
  46 (global 'human-bytes)
  47
  48 "misc.lsp"