Tweak formatting (no functional changes)
Bring it more in line with what I consider OK nowadays — proper copyright header, form-feed ^L between sections, tweaked section headers, indentation…
This commit is contained in:
parent
5d722c47b0
commit
f3b98f33d8
218
eksd-unix.lisp
218
eksd-unix.lisp
|
@ -1,11 +1,19 @@
|
||||||
;; This file is free software: you can redistribute it and/or modify
|
;;;; eksd-unix: UNIX-style cli interface for the xxd-clone eksd.
|
||||||
;; it under the terms of version 3 of the GNU General Public License
|
|
||||||
;; as published by the Free Software Foundation.
|
;; Copyright © 2019–2024 Jaidyn Ann <jadedctrl@posteo.at>
|
||||||
|
;;
|
||||||
|
;; This program is free software: you can redistribute it and/or
|
||||||
|
;; modify it under the terms of the GNU General Public License as
|
||||||
|
;; published by the Free Software Foundation, either version 3 of
|
||||||
|
;; the License, or (at your option) any later version.
|
||||||
;;
|
;;
|
||||||
;; This program is distributed in the hope that it will be useful,
|
;; This program is distributed in the hope that it will be useful,
|
||||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;; GNU General Public License for more details.
|
;; GNU General Public License for more details.
|
||||||
|
;;
|
||||||
|
;; You should have received a copy of the GNU General Public License
|
||||||
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(defpackage :eksd-unix
|
(defpackage :eksd-unix
|
||||||
(:use :cl :eksd)
|
(:use :cl :eksd)
|
||||||
|
@ -14,61 +22,61 @@
|
||||||
|
|
||||||
(in-package :eksd-unix)
|
(in-package :eksd-unix)
|
||||||
|
|
||||||
;; —————————————————————————————————————
|
|
||||||
|
;;; —————————————————————————————————————
|
||||||
(opts:define-opts
|
(opts:define-opts
|
||||||
(:name :help
|
(:name :help
|
||||||
:description "print this help text."
|
:description "print this help text."
|
||||||
:short #\h :long "help")
|
:short #\h :long "help")
|
||||||
(:name :reverse
|
(:name :reverse
|
||||||
:description "reverse operation: convert hexdump into binary."
|
:description "reverse operation: convert hexdump into binary."
|
||||||
:short #\r :long "reverse")
|
:short #\r :long "reverse")
|
||||||
(:name :upcase
|
(:name :upcase
|
||||||
:description "print hexadecimal in uppercase."
|
:description "print hexadecimal in uppercase."
|
||||||
:short #\u :long "upcase")
|
:short #\u :long "upcase")
|
||||||
(:name :width
|
(:name :width
|
||||||
:description "octets per line; 16 as default."
|
:description "octets per line; 16 as default."
|
||||||
:short #\c :long "cols"
|
:short #\c :long "cols"
|
||||||
:arg-parser #'parse-integer
|
:arg-parser #'parse-integer
|
||||||
:meta-var "COLS")
|
:meta-var "COLS")
|
||||||
(:name :seek
|
(:name :seek
|
||||||
:description "skip given amount of bytes in file."
|
:description "skip given amount of bytes in file."
|
||||||
:short #\s :long "seek"
|
:short #\s :long "seek"
|
||||||
:arg-parser #'parse-integer
|
:arg-parser #'parse-integer
|
||||||
:meta-var "OFFSET")
|
:meta-var "OFFSET")
|
||||||
(:name :group
|
(:name :group
|
||||||
:description "octets per group; 2 as default."
|
:description "octets per group; 2 as default."
|
||||||
:short #\g :long "groupsize"
|
:short #\g :long "groupsize"
|
||||||
:arg-parser #'parse-integer
|
:arg-parser #'parse-integer
|
||||||
:meta-var "OCTETS")
|
:meta-var "OCTETS")
|
||||||
(:name :ascii
|
(:name :ascii
|
||||||
:description "use simple-ascii for previews; default is fun."
|
:description "use simple-ascii for previews; default is fun."
|
||||||
:short #\a :long "ascii")
|
:short #\a :long "ascii")
|
||||||
(:name :text-table
|
(:name :text-table
|
||||||
:description "specify a text-table; semi-ascii as default."
|
:description "specify a text-table; semi-ascii as default."
|
||||||
:short #\t :long "table"
|
:short #\t :long "table"
|
||||||
:arg-parser #'probe-file
|
:arg-parser #'probe-file
|
||||||
:meta-var "TABLE"))
|
:meta-var "TABLE"))
|
||||||
|
|
||||||
|
|
||||||
;; —————————————————————————————————————
|
|
||||||
;; MACROS
|
;;; Macros
|
||||||
|
;;; —————————————————————————————————————
|
||||||
;; LIST SYMBOL FORM
|
;; list symbol form
|
||||||
(defmacro when-opt (opts option body)
|
(defmacro when-opt (opts option body)
|
||||||
`(when (getf ,opts ,option)
|
`(when (getf ,opts ,option)
|
||||||
,body))
|
,body))
|
||||||
|
|
||||||
;; LIST SYMBOL FORM FORM
|
;; list symbol form form
|
||||||
(defmacro if-opt (opts option if-form &optional else-form)
|
(defmacro if-opt (opts option if-form &optional else-form)
|
||||||
`(if (getf ,opts ,option)
|
`(if (getf ,opts ,option)
|
||||||
,if-form ,else-form))
|
,if-form ,else-form))
|
||||||
|
|
||||||
|
|
||||||
;; —————————————————————————————————————
|
|
||||||
;; MAIN - INVOCATION
|
;;; Main - Invocation
|
||||||
|
;;; —————————————————————————————————————
|
||||||
;; NIL → NIL
|
;; nil → nil
|
||||||
(defun invoke ()
|
(defun invoke ()
|
||||||
"Actual invocation of the program. This is what you should set as :toplevel."
|
"Actual invocation of the program. This is what you should set as :toplevel."
|
||||||
(multiple-value-bind (opts free) (opts:get-opts)
|
(multiple-value-bind (opts free) (opts:get-opts)
|
||||||
|
@ -85,54 +93,51 @@
|
||||||
|
|
||||||
(close input-stream))))
|
(close input-stream))))
|
||||||
|
|
||||||
|
;; number stream → nil
|
||||||
;; NUMBER STREAM → NIL
|
|
||||||
(defun help (&optional (exit-code 0) (stream *standard-output*))
|
(defun help (&optional (exit-code 0) (stream *standard-output*))
|
||||||
"Prints help message and dies."
|
"Prints help message and dies."
|
||||||
(unix-opts:describe :prefix "usage: eksd [-hr] [-t table-file] file"
|
(unix-opts:describe :prefix "usage: eksd [-hr] [-t table-file] file"
|
||||||
:stream stream)
|
:stream stream)
|
||||||
(unix-opts:exit exit-code))
|
(unix-opts:exit exit-code))
|
||||||
|
|
||||||
;; —————————————————
|
; list stream → nil
|
||||||
|
|
||||||
;; LIST STREAM → NIL
|
|
||||||
(defun reverse-or-dump (opts input-stream)
|
(defun reverse-or-dump (opts input-stream)
|
||||||
"Determine if a hexdump or reversal's necessary— and execute it."
|
"Determine if a hexdump or reversal's necessary— and execute it."
|
||||||
(if-opt opts :reverse
|
(if-opt opts :reverse
|
||||||
(reverse-stream input-stream)
|
(reverse-stream input-stream)
|
||||||
(apply #'print-stream (choose-pstream-args opts input-stream))))
|
(apply #'print-stream (choose-pstream-args opts input-stream))))
|
||||||
|
|
||||||
|
|
||||||
;; —————————————————————————————————————
|
|
||||||
;; INPUT
|
;;; Input
|
||||||
|
;;; —————————————————————————————————————
|
||||||
;; LIST → STREAM
|
;; list → stream
|
||||||
(defun choose-input-stream (free-args opts)
|
(defun choose-input-stream (free-args opts)
|
||||||
"Select an input stream, between a file passed in free-args or stdin."
|
"Select an input stream, between a file passed in free-args or stdin."
|
||||||
(let* ((input-file (car free-args))
|
(let* ((input-file (car free-args))
|
||||||
(input-file-p (ignore-errors (probe-file input-file)))
|
(input-file-p (ignore-errors (probe-file input-file)))
|
||||||
(stdin-p (listen *standard-input*)))
|
(stdin-p (listen *standard-input*)))
|
||||||
(cond ((and (getf opts :reverse) input-file-p)
|
(cond ((and (getf opts :reverse) input-file-p
|
||||||
(open input-file :direction :input :element-type 'character))
|
(open input-file :direction :input :element-type 'character)))
|
||||||
(input-file-p (open-byte input-file))
|
(input-file-p (open-byte input-file))
|
||||||
(stdin-p *standard-input*))))
|
(stdin-p *standard-input*))))
|
||||||
|
|
||||||
;; LIST → NIL
|
;; list → nil
|
||||||
(defun choose-text-table (opts)
|
(defun choose-text-table (opts)
|
||||||
"Choose the appropriate text-table— user-given or otherwise."
|
"Choose the appropriate text-table— user-given or otherwise."
|
||||||
(if-opt opts :text-table
|
(if-opt opts :text-table
|
||||||
(setq *text-table* (parse-table-file (getf opts :text-table)))
|
(setq *text-table* (parse-table-file (getf opts :text-table)))
|
||||||
(if-opt opts :ascii
|
(if-opt opts :ascii
|
||||||
(setq *text-table* eksd:*ascii-text-table*)
|
(setq *text-table* eksd:*ascii-text-table*)
|
||||||
(setq *text-table* eksd:*fancy-text-table*))))
|
(setq *text-table* eksd:*fancy-text-table*))))
|
||||||
|
|
||||||
;; LIST STREAM → NIL
|
;; list stream → nil
|
||||||
(defun choose-stream-position (opts stream)
|
(defun choose-stream-position (opts stream)
|
||||||
"Choose the correct stream position— if seek arg used, etc."
|
"Choose the correct stream position— if seek arg used, etc."
|
||||||
(when (not (eq stream *standard-input*))
|
(when (not (eq stream *standard-input*))
|
||||||
(if-opt opts :seek (file-position stream (getf opts :seek)))))
|
(if-opt opts :seek (file-position stream (getf opts :seek)))))
|
||||||
|
|
||||||
;; LIST STREAM → LIST
|
;; list stream → list
|
||||||
(defun choose-pstream-args (opts input-stream)
|
(defun choose-pstream-args (opts input-stream)
|
||||||
"Take all options, and return the appropriate arguments to #'print-stream."
|
"Take all options, and return the appropriate arguments to #'print-stream."
|
||||||
(let ((args (list input-stream)))
|
(let ((args (list input-stream)))
|
||||||
|
@ -141,33 +146,33 @@
|
||||||
(when-opt opts :group (nconc args `(:group ,(getf opts :group))))
|
(when-opt opts :group (nconc args `(:group ,(getf opts :group))))
|
||||||
args))
|
args))
|
||||||
|
|
||||||
;; —————————————————
|
|
||||||
|
;;; —————————————————
|
||||||
|
|
||||||
;; STREAM NUMBER NUMBER → LIST NUMBER
|
;; stream number number → list number
|
||||||
(defun get-line-hex (stream index width)
|
(defun get-line-hex (stream index width)
|
||||||
"Return a line's worth of octets; and a new octet-index."
|
"Return a line's worth of octets; and a new octet-index."
|
||||||
(values
|
(values
|
||||||
(loop :while (listen stream) :for i :from 1 :to width
|
(loop :while (listen stream) :for i :from 1 :to width
|
||||||
:collect (eksd:read-hex stream) :do (incf index))
|
:collect (eksd:read-hex stream) :do (incf index))
|
||||||
index))
|
index))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;; Output
|
||||||
;; —————————————————————————————————————
|
;; —————————————————————————————————————
|
||||||
;; OUTPUT
|
;; stream number number stream
|
||||||
|
|
||||||
;; STREAM NUMBER NUMBER STREAM
|
|
||||||
(defun print-stream (stream &key (width 16) (group 2) (upcase nil) (out 't))
|
(defun print-stream (stream &key (width 16) (group 2) (upcase nil) (out 't))
|
||||||
"Print an entire stream in hex, xxd-style."
|
"Print an entire stream in hex, xxd-style."
|
||||||
(let ((index 0))
|
(let ((index 0))
|
||||||
(loop :while (listen stream)
|
(loop :while (listen stream)
|
||||||
:do (setq index (print-line stream :out out :index index
|
:do (setq index (print-line stream :out out :index index
|
||||||
:group group :width width
|
:group group :width width
|
||||||
:upcase upcase)))))
|
:upcase upcase)))))
|
||||||
|
|
||||||
|
;; stream stream number number number → number
|
||||||
;; STREAM STREAM NUMBER NUMBER NUMBER → NUMBER
|
|
||||||
(defun print-line (stream &key (out 't) (index 0) (width 16) (group 2)
|
(defun print-line (stream &key (out 't) (index 0) (width 16) (group 2)
|
||||||
(upcase nil))
|
(upcase nil))
|
||||||
"Print a given line of xxd-style output— index, bytes, preview and all.
|
"Print a given line of xxd-style output— index, bytes, preview and all.
|
||||||
Returns the new index of the stream."
|
Returns the new index of the stream."
|
||||||
(multiple-value-bind (hexes new-index) (get-line-hex stream index width)
|
(multiple-value-bind (hexes new-index) (get-line-hex stream index width)
|
||||||
|
@ -177,29 +182,29 @@
|
||||||
(format t "~%")
|
(format t "~%")
|
||||||
new-index))
|
new-index))
|
||||||
|
|
||||||
;; NUMBER STREAM → NIL
|
;; number stream → nil
|
||||||
(defun print-index (index &optional (out 't))
|
(defun print-index (index &optional (out 't))
|
||||||
"Print the current index, padded to 8 char-length and in hexadecimal."
|
"Print the current index, padded to 8 char-length and in hexadecimal."
|
||||||
(format out "~8,,,'0@A: " (string-downcase (eksd:integer-to-hex index))))
|
(format out "~8,,,'0@A: " (string-downcase (eksd:integer-to-hex index))))
|
||||||
|
|
||||||
;; LIST_OF_STRINGS NUMBER STREAM → NIL
|
;; list-of-strings number stream → nil
|
||||||
(defun print-bytes (hexes group-size upcase &optional (out 't))
|
(defun print-bytes (hexes group-size upcase &optional (out 't))
|
||||||
"Print the given list of bytes on a line in specified-sized groupings."
|
"Print the given list of bytes on a line in specified-sized groupings."
|
||||||
(mapcar (lambda (group)
|
(mapcar (lambda (group)
|
||||||
(format out (if upcase "~{~@:(~a~)~} " "~{~(~a~)~} ") group))
|
(format out (if upcase "~{~@:(~a~)~} " "~{~(~a~)~} ") group))
|
||||||
(pairs hexes group-size)))
|
(pairs hexes group-size)))
|
||||||
|
|
||||||
;; LIST_OF_STRINGS STREAM → NIL
|
;; list-of-strings stream → nil
|
||||||
(defun print-preview (hexes &optional (out 't))
|
(defun print-preview (hexes &optional (out 't))
|
||||||
"Print a given list of bytes' preview, as per ASCII table."
|
"Print a given list of bytes' preview, as per ASCII table."
|
||||||
(format out " ~{~A~}"
|
(format out " ~{~A~}"
|
||||||
(mapcar (lambda (hex) (hex-to-char hex *text-table*)) hexes)))
|
(mapcar (lambda (hex) (hex-to-char hex *text-table*)) hexes)))
|
||||||
|
|
||||||
|
|
||||||
;; —————————————————————————————————————
|
|
||||||
;; REVERSAL
|
;;; Reversal
|
||||||
|
;;; —————————————————————————————————————
|
||||||
;; STREAM STREAM → NIL
|
;; stream stream → nil
|
||||||
(defun reverse-stream (stream &optional (out *standard-output*))
|
(defun reverse-stream (stream &optional (out *standard-output*))
|
||||||
"Take a stream of xxd-style/eksd-output hexcode and convert back into binary."
|
"Take a stream of xxd-style/eksd-output hexcode and convert back into binary."
|
||||||
(loop :while (listen stream)
|
(loop :while (listen stream)
|
||||||
|
@ -207,26 +212,26 @@
|
||||||
(write-byte (eksd:hex-to-integer byte) out))
|
(write-byte (eksd:hex-to-integer byte) out))
|
||||||
(line-to-hexes (read-line stream)))))
|
(line-to-hexes (read-line stream)))))
|
||||||
|
|
||||||
;; STRING → LIST
|
;; string → list
|
||||||
(defun line-to-hexes (line)
|
(defun line-to-hexes (line)
|
||||||
"Convert an xxd-style/eksd-output hexcode line into a list of hexcodes."
|
"Convert an xxd-style/eksd-output hexcode line into a list of hexcodes."
|
||||||
(mapcar (lambda (pair) (format nil "~{~A~}" pair))
|
(mapcar (lambda (pair) (format nil "~{~A~}" pair))
|
||||||
(string-pairs
|
(string-pairs
|
||||||
(remove #\space (car (cl-strings:split
|
(remove #\space (car (cl-strings:split
|
||||||
(left-clip-string line ": ")" "))))))
|
(left-clip-string line ": ")" "))))))
|
||||||
|
|
||||||
|
|
||||||
;; —————————————————————————————————————
|
|
||||||
;; TEXT-TABLES
|
;;; Text-tables
|
||||||
|
;;; —————————————————————————————————————
|
||||||
;; STRING → LIST
|
;; string → list
|
||||||
(defun parse-table-line (string)
|
(defun parse-table-line (string)
|
||||||
"Parse a text-table line into a pair of hex-code and preview character."
|
"Parse a text-table line into a pair of hex-code and preview character."
|
||||||
(let ((chars (char-list string)))
|
(let ((chars (char-list string)))
|
||||||
(list (format nil "~{~a~}" (list (car chars) (cadr chars)))
|
(list (format nil "~{~a~}" (list (car chars) (cadr chars)))
|
||||||
(tail chars))))
|
(tail chars))))
|
||||||
|
|
||||||
;; PATHNAME → LIST
|
;; pathname → list
|
||||||
(defun parse-table-file (pathname)
|
(defun parse-table-file (pathname)
|
||||||
"Parse a text-table file (hexcode followed by preview character) into a list
|
"Parse a text-table file (hexcode followed by preview character) into a list
|
||||||
of lists '(hexcode character)."
|
of lists '(hexcode character)."
|
||||||
|
@ -235,17 +240,17 @@
|
||||||
:collect (parse-table-line (read-line istream)))))
|
:collect (parse-table-line (read-line istream)))))
|
||||||
|
|
||||||
|
|
||||||
;; —————————————————————————————————————
|
|
||||||
;; MISC
|
;;; Misc
|
||||||
|
;;; —————————————————————————————————————
|
||||||
;; LIST NUMBER VARYING → LIST
|
;; list number varying → list
|
||||||
(defun list-pad (list target-length &optional (padding nil))
|
(defun list-pad (list target-length &optional (padding nil))
|
||||||
"Pad a list out to length, by appending padding as necessary."
|
"Pad a list out to length, by appending padding as necessary."
|
||||||
(if (not (eq target-length (length list)))
|
(if (not (eq target-length (length list)))
|
||||||
(list-pad (append list (list padding)) target-length padding)
|
(list-pad (append list (list padding)) target-length padding)
|
||||||
list))
|
list))
|
||||||
|
|
||||||
;; LIST NUMBER → LIST
|
;; list number → list
|
||||||
(defun pairs (list width &optional pairs)
|
(defun pairs (list width &optional pairs)
|
||||||
"Split a list into pairs (sublist) of a given width."
|
"Split a list into pairs (sublist) of a given width."
|
||||||
(cond ((not list) pairs)
|
(cond ((not list) pairs)
|
||||||
|
@ -253,26 +258,31 @@
|
||||||
(pairs (cdr list) width (nconc pairs `((,(car list))))))
|
(pairs (cdr list) width (nconc pairs `((,(car list))))))
|
||||||
((not (eq width (length (tail pairs))))
|
((not (eq width (length (tail pairs))))
|
||||||
(pairs (cdr list) width
|
(pairs (cdr list) width
|
||||||
(nconc (de-tail pairs) `(,(nconc (tail pairs) `(,(car list)))))))))
|
(nconc (de-tail pairs) `(,(nconc (tail pairs) `(,(car list)))))))))
|
||||||
|
|
||||||
;; STRING CHARACTER → STRING
|
;; string character → string
|
||||||
(defun left-clip-string (string &optional (seperator #\space))
|
(defun left-clip-string (string &optional (seperator #\space))
|
||||||
"Clip a string up to the first instance of the seperator."
|
"Clip a string up to the first instance of the seperator."
|
||||||
(reduce (lambda (a b) (format nil "~A~A~A" a seperator b))
|
(reduce (lambda (a b) (format nil "~A~A~A" a seperator b))
|
||||||
(cdr (cl-strings:split string seperator))))
|
(cdr (cl-strings:split string seperator))))
|
||||||
|
|
||||||
;; STRING NUMBER → LIST
|
;; string number → list
|
||||||
(defun string-pairs (string &optional (pair-length 2))
|
(defun string-pairs (string &optional (pair-length 2))
|
||||||
"Return a list of characters from a string in pairs of given length."
|
"Return a list of characters from a string in pairs of given length."
|
||||||
(pairs (char-list string) pair-length))
|
(pairs (char-list string) pair-length))
|
||||||
|
|
||||||
;; PATHNAME → STREAM
|
;; pathname → stream
|
||||||
(defun open-byte (pathname)
|
(defun open-byte (pathname)
|
||||||
"Open an input file as a byte-stream."
|
"Open an input file as a byte-stream."
|
||||||
(open pathname :direction :input :element-type '(unsigned-byte 8)))
|
(open pathname :direction :input :element-type '(unsigned-byte 8)))
|
||||||
|
|
||||||
;; —————————————————
|
;; string → list
|
||||||
|
(defun char-list (string)
|
||||||
|
"Convert a string into a list of characters."
|
||||||
|
(loop :for char :across string :collect char))
|
||||||
|
|
||||||
|
;; list → list
|
||||||
|
(defun de-tail (list)
|
||||||
|
"Remove the last element from a list."
|
||||||
|
(reverse (cdr (reverse list))))
|
||||||
|
|
||||||
(defun char-list (string) (loop :for char :across string :collect char))
|
|
||||||
(defun de-tail (list) (reverse (cdr (reverse list))))
|
|
||||||
(defun tail (list) (car (last list)))
|
|
||||||
|
|
24
eksd.asd
24
eksd.asd
|
@ -1,15 +1,15 @@
|
||||||
(defsystem "eksd"
|
(defsystem "eksd"
|
||||||
:version "0.1"
|
:version "0.1"
|
||||||
:license "GPLv3"
|
:license "GPLv3"
|
||||||
:author "Jaidyn Ann <jadedctrl@teknik.io>"
|
:author "Jaidyn Ann <jadedctrl@teknik.io>"
|
||||||
:description "For reading files into hex— `xxd`-like with text-tables."
|
:description "For reading files into hex— `xxd`-like with text-tables."
|
||||||
:depends-on ()
|
:depends-on ()
|
||||||
:components ((:file "eksd")))
|
:components ((:file "eksd")))
|
||||||
|
|
||||||
(defsystem "eksd-unix"
|
(defsystem "eksd-unix"
|
||||||
:version "0.1"
|
:version "0.1"
|
||||||
:license "GPLv3"
|
:license "GPLv3"
|
||||||
:author "Jaidyn Ann <jadedctrl@teknik.io>"
|
:author "Jaidyn Ann <jadedctrl@teknik.io>"
|
||||||
:description "UNIX terminal front-tend to eksd. `xxd` twin."
|
:description "UNIX terminal front-tend to eksd. `xxd` twin."
|
||||||
:depends-on (:eksd :unix-opts :cl-strings)
|
:depends-on (:eksd :unix-opts :cl-strings)
|
||||||
:components ((:file "eksd-unix")))
|
:components ((:file "eksd-unix")))
|
||||||
|
|
74
eksd.lisp
74
eksd.lisp
|
@ -1,11 +1,19 @@
|
||||||
;; This file is free software: you can redistribute it and/or modify
|
;;;; eksd: Backend to the xxd-clone hex-dump program eksd.
|
||||||
;; it under the terms of version 3 of the GNU General Public License
|
|
||||||
;; as published by the Free Software Foundation.
|
;; Copyright © 2019–2024 Jaidyn Ann <jadedctrl@posteo.at>
|
||||||
|
;;
|
||||||
|
;; This program is free software: you can redistribute it and/or
|
||||||
|
;; modify it under the terms of the GNU General Public License as
|
||||||
|
;; published by the Free Software Foundation, either version 3 of
|
||||||
|
;; the License, or (at your option) any later version.
|
||||||
;;
|
;;
|
||||||
;; This program is distributed in the hope that it will be useful,
|
;; This program is distributed in the hope that it will be useful,
|
||||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
;; GNU General Public License for more details.
|
;; GNU General Public License for more details.
|
||||||
|
;;
|
||||||
|
;; You should have received a copy of the GNU General Public License
|
||||||
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(defpackage :eksd
|
(defpackage :eksd
|
||||||
(:use :cl)
|
(:use :cl)
|
||||||
|
@ -22,8 +30,9 @@
|
||||||
|
|
||||||
(in-package :eksd)
|
(in-package :eksd)
|
||||||
|
|
||||||
;; —————————————————————————————————————
|
|
||||||
|
;;; Constants
|
||||||
|
;;; —————————————————————————————————————
|
||||||
(defparameter *ascii-text-table*
|
(defparameter *ascii-text-table*
|
||||||
'(("20" #\space)("21" #\!)("22" #\")("23" #\#)("24" #\$) ("25" #\%)
|
'(("20" #\space)("21" #\!)("22" #\")("23" #\#)("24" #\$) ("25" #\%)
|
||||||
("26" #\&) ("27" #\') ("28" #\() ("29" #\)) ("2A" #\*) ("2B" #\+)
|
("26" #\&) ("27" #\') ("28" #\() ("29" #\)) ("2A" #\*) ("2B" #\+)
|
||||||
|
@ -47,16 +56,16 @@
|
||||||
(defparameter *fancy-text-table* (append *ascii-text-table* *fancy-text-bits*))
|
(defparameter *fancy-text-table* (append *ascii-text-table* *fancy-text-bits*))
|
||||||
|
|
||||||
|
|
||||||
;; —————————————————————————————————————
|
|
||||||
;; X → HEX
|
;;; X → Hex
|
||||||
|
;;; —————————————————————————————————————
|
||||||
;; STREAM → LIST_OF_STRINGS
|
;; stream → list-of-strings
|
||||||
(defun stream-to-hex (stream)
|
(defun stream-to-hex (stream)
|
||||||
"Return a stream's data as a list of hexadecimal strings."
|
"Return a stream's data as a list of hexadecimal strings."
|
||||||
(loop :while (listen stream)
|
(loop :while (listen stream)
|
||||||
:collect (read-hex stream)))
|
:collect (read-hex stream)))
|
||||||
|
|
||||||
;; PATHNAME → LIST_OF_STRINGS
|
;; pathname → list-of-strings
|
||||||
(defun file-to-hex (pathname)
|
(defun file-to-hex (pathname)
|
||||||
"Return a list of a file's octets represented in hexadecimal strings."
|
"Return a list of a file's octets represented in hexadecimal strings."
|
||||||
(with-open-file (fstream pathname
|
(with-open-file (fstream pathname
|
||||||
|
@ -64,17 +73,16 @@
|
||||||
(stream-to-hex fstream)))
|
(stream-to-hex fstream)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; —————————————————————————————————————
|
;;; Hex → X
|
||||||
;; HEX → X
|
;;; —————————————————————————————————————
|
||||||
|
;; list-of-strings stream → nil
|
||||||
;; LIST_OF_STRINGS STREAM → NIL
|
|
||||||
(defun hex-to-stream (hexes stream)
|
(defun hex-to-stream (hexes stream)
|
||||||
"Write a list of bytes (in hex-string format) to a stream."
|
"Write a list of bytes (in hex-string format) to a stream."
|
||||||
(loop :for hex :in hexes
|
(loop :for hex :in hexes
|
||||||
:do (write-hex hex stream)))
|
:do (write-hex hex stream)))
|
||||||
|
|
||||||
;; LIST_OF_STRINGS PATHNAME → NIL
|
;; list-of-strings pathname → nil
|
||||||
(defun hex-to-file (hexes pathname)
|
(defun hex-to-file (hexes pathname)
|
||||||
"Write a list of bytes (in hex-string format) to a file."
|
"Write a list of bytes (in hex-string format) to a file."
|
||||||
(with-open-file (fstream pathname
|
(with-open-file (fstream pathname
|
||||||
|
@ -82,62 +90,60 @@
|
||||||
(hex-to-stream hexes fstream)))
|
(hex-to-stream hexes fstream)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;; Text-table fun
|
||||||
;; —————————————————————————————————————
|
;; —————————————————————————————————————
|
||||||
;; TEXT-TABLE FUN
|
|
||||||
|
|
||||||
(defgeneric hex-to-char (hex/es &optional text-table)
|
(defgeneric hex-to-char (hex/es &optional text-table)
|
||||||
(:documentation "Return a hexadecimal's respective character (as string)
|
(:documentation "Return a hexadecimal's respective character (as string)
|
||||||
according to the given text-table."))
|
according to the given text-table."))
|
||||||
|
|
||||||
;; STRING LIST → STRING
|
;; string list → string
|
||||||
(defmethod hex-to-char ((hex string) &optional (text-table *ascii-text-table*))
|
(defmethod hex-to-char ((hex string) &optional (text-table *ascii-text-table*))
|
||||||
(or (cadr (assoc hex text-table :test #'equal)) #\.))
|
(or (cadr (assoc hex text-table :test #'equal)) #\.))
|
||||||
|
|
||||||
;; LIST_OF_STRINGS LIST → LIST_OF_STRINGS
|
;; list-of-strings list → list-of-strings
|
||||||
(defmethod hex-to-char ((hexes list) &optional (text-table *ascii-text-table*))
|
(defmethod hex-to-char ((hexes list) &optional (text-table *ascii-text-table*))
|
||||||
(mapcar (lambda (hex) (hex-to-char hex text-table)) hexes))
|
(mapcar (lambda (hex) (hex-to-char hex text-table)) hexes))
|
||||||
|
|
||||||
|
|
||||||
;; PATHNAME LIST → LIST_OF_STRINGS
|
;; pathname list → list_of_strings
|
||||||
(defun file-to-char (pathname &optional (text-table *ascii-text-table*))
|
(defun file-to-char (pathname &optional (text-table *ascii-text-table*))
|
||||||
"Print character representation of a file, as per the given character table."
|
"Print character representation of a file, as per the given character table."
|
||||||
(hex-to-char (file-to-hex pathname) text-table))
|
(hex-to-char (file-to-hex pathname) text-table))
|
||||||
|
|
||||||
|
;; character list → string
|
||||||
;; CHARACTER LIST → STRING
|
|
||||||
(defun char-hex (char &optional text-table)
|
(defun char-hex (char &optional text-table)
|
||||||
"Return a character's hex, given a text-table."
|
"Return a character's hex, given a text-table."
|
||||||
(if (not text-table)
|
(if (not text-table)
|
||||||
(integer-to-hex (char-code char))
|
(integer-to-hex (char-code char))
|
||||||
(cadr (assoc char (mapcar #'reverse text-table)))))
|
(cadr (assoc char (mapcar #'reverse text-table)))))
|
||||||
|
|
||||||
|
;; string list → list
|
||||||
(defun string-hex (string &optional text-table)
|
(defun string-hex (string &optional text-table)
|
||||||
|
"Given a string and text-table, return a list of its characters’ hex-codes."
|
||||||
(loop :for char :across string
|
(loop :for char :across string
|
||||||
:collect (char-hex char text-table)))
|
:collect (char-hex char text-table)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; —————————————————————————————————————
|
;;; Misc
|
||||||
;; MISC
|
;;; —————————————————————————————————————
|
||||||
|
;; stream → string
|
||||||
;; STREAM → STRING
|
|
||||||
(defun read-hex (stream)
|
(defun read-hex (stream)
|
||||||
"Read a byte from a stream as a hexcode."
|
"Read a byte from a stream as a hexcode."
|
||||||
(integer-to-hex (read-byte stream)))
|
(integer-to-hex (read-byte stream)))
|
||||||
|
|
||||||
;; STREAM → STRING
|
;; stream → string
|
||||||
(defun write-hex (hex stream)
|
(defun write-hex (hex stream)
|
||||||
"Read a byte from a stream as a hexcode."
|
"Read a byte from a stream as a hexcode."
|
||||||
(write-byte (hex-to-integer hex) stream))
|
(write-byte (hex-to-integer hex) stream))
|
||||||
|
|
||||||
|
;; number → string
|
||||||
;; NUMBER → STRING
|
|
||||||
(defun integer-to-hex (number)
|
(defun integer-to-hex (number)
|
||||||
"Return the base-16 of a number."
|
"Return the base-16 of a number."
|
||||||
(format nil "~2,'0x" number))
|
(format nil "~2,'0x" number))
|
||||||
|
|
||||||
;; STRING → NUMBER
|
;; string → number
|
||||||
(defun hex-to-integer (hex)
|
(defun hex-to-integer (hex)
|
||||||
"Convert hex to a base-10 integer."
|
"Convert hex to a base-10 integer."
|
||||||
(parse-integer hex :radix 16))
|
(parse-integer hex :radix 16))
|
||||||
|
|
Ŝarĝante…
Reference in New Issue