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:
Jaidyn Ann 2024-05-26 17:35:11 -05:00
parent 5d722c47b0
commit f3b98f33d8
3 changed files with 166 additions and 150 deletions

View File

@ -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 © 20192024 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,8 +22,8 @@
(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."
@ -51,24 +59,24 @@
: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,17 +93,14 @@
(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
@ -103,21 +108,21 @@
(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
@ -126,13 +131,13 @@
(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,9 +146,10 @@
(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
@ -152,10 +158,10 @@
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))
@ -164,8 +170,7 @@
: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.
@ -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,7 +212,7 @@
(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))
@ -216,17 +221,17 @@
(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)
@ -255,24 +260,29 @@
(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)))

View File

@ -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 © 20192024 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))