filedump.lsp
 Version 1.00  10 June 2005
 Author Steven Jones

 Contact jones57@swbell.net include the word "nyquist" in subject line  

 The contents of this file are released under the terms of the GNU General
 Public License. See the file LICENSE.txt

 File hex dump utility.

function

 (filedump filename [:binary][:echo])
 Produce hex dump of file.

 filename - String.
 :binary  - Boolean. If true open filename as a binary file. Default nil
 :echo    - Boolean. If true output results to standard out. Default t
 return   - String | NIL. If echo is true the results are dumped to the 
            terminal and the return value is NIL. If echo is false the 
            result is returned as a string.

;; filedump.lsp
;; Version 1.00  10 June 2005
;; Author Steven Jones
;;
;; Contact jones57@swbell.net include the word "nyquist" in subject line  
;;
;; The contents of this file are released under the terms of the GNU General
;; Public License. See the file LICENSE.txt
;;
;; File hex dump utility.
;;

(require 'su)
(require 'nbase)
(provide 'filedump)
(current-file "filedump")


(setf filedump:*ASCII* (make-array 128))

(dotimes (i 128)
  (setf (aref filedump:*ASCII* i)
	(cond ((< i 32) ".")
	      ((> i 126) ".")
	      (t (format nil "~a" (code-char i))))))


(defun filedump:format-position (pos)
  (setf pos (nbase pos 16))
  (let (width dif)
    (setf width 6)
    (while (< (length pos) width)
      (setf pos (strcat "0" pos)))
    pos))


(defun filedump:format-byte (byte)
  (let (xbyte)
    (setf xbyte (nbase byte 16))
    (if (< (length xbyte) 2)
	(setf xbyte (strcat "0" xbyte)))
    xbyte))


(defun filedump:format-ascii (byte)
  (aref filedump:*ASCII* byte))


;; @doc function filedump
;; (filedump filename [:binary][:echo])
;; Produce hex dump of file.
;;
;; filename - String.
;; :binary  - Boolean. If true open filename as a binary file. Default nil
;; :echo    - Boolean. If true output results to standard out. Default t
;; return   - String | NIL. If echo is true the results are dumped to the 
;;            terminal and the return value is NIL. If echo is false the 
;;            result is returned as a string.
;;

(defun filedump (filename &key (binary 'nil)(echo 't))
  (let (fobj out more pos index byte xline cline)
    (setf fobj (if binary 
		   (open-binary filename :direction :input)
		 (open filename :direction :input)))
    (assert fobj
	    (format nil "filedump could not open file ~s" filename))
    (setf pos 0)
    (setf out (format nil "~s~%" filename))
    (setf more 't)
    (while more
      (setf out (format nil "~a~%~a  " out (filedump:format-position pos)))
      (setf index 0)
      (setf xline "")
      (setf cline "")
      (while (and more (< index 16))
	(setf byte (read-byte fobj))
	(cond
	 (byte 
	  (setf index (1+ index))
	  (setf xline (strcat xline (filedump:format-byte byte) " "))
	  (if (zerop (rem index 4))
	      (setf xline (strcat xline " ")))
	  (setf cline (strcat cline (filedump:format-ascii byte))))
	 (t 
	  (setf more nil)))
	) ;; end inner while 
      (setf xline (su:ljust xline 52))
      (setf out (format nil "~a~a  ~a" out xline cline))\
      (setf pos (+ pos index))
      ) ;; end outer while
    (close fobj)
    (format echo "~a~%" out)
    ))