utils.lisp 2.1 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344
  1. ;;; -*- Mode: Lisp; show-trailing-whitespace: t; Base: 10; indent-tabs: nil; Syntax: ANSI-Common-Lisp; Package: UTILS; -*-
  2. ;;; Copyright (c) 2013, Mark VandenBrink. All rights reserved.
  3. (in-package #:utils)
  4. (defparameter *break-on-warn-user* nil "set to T if you'd like to stop in warn user")
  5. ;;; COMPLETELY UNPORTABLE!!!
  6. (defun warn-user (format-string &rest args)
  7. "print a warning error to *ERROR-OUTPUT* and continue"
  8. (when *break-on-warn-user* (break "Breaking in WARN-USER"))
  9. (format *error-output* "~&********************************************************************************~%")
  10. (format *error-output* "~&~&WARNING in ~a:: " (ccl::%last-fn-on-stack 1))
  11. (apply #'format *error-output* format-string args)
  12. (format *error-output* "**********************************************************************************~%"))
  13. (defparameter *max-raw-bytes-print-len* 10 "Max number of octets to print from an array")
  14. (defun printable-array (array &optional (max-len *max-raw-bytes-print-len*))
  15. "Given an array, return a string of the first *MAX-RAW-BYTES-PRINT-LEN* bytes"
  16. (let* ((len (length array))
  17. (print-len (min len max-len))
  18. (printable-array (make-array print-len :displaced-to array)))
  19. (format nil "[~:d of ~:d bytes] <~x>" print-len len printable-array)))
  20. (defun upto-null (string)
  21. "Trim STRING to end at first NULL found"
  22. (subseq string 0 (position #\Null string)))
  23. (defun dump-data (file-name data)
  24. (with-open-file (f file-name :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
  25. (write-sequence data f)))
  26. (defmethod has-extension ((n string) ext)
  27. "Probably should use CL's PATHNAME methods, but simply looking at the .XXX portion of a filename
  28. to see if it matches. This is the string version that makes a PATHNAME and calls the PATHNAME version."
  29. (has-extension (parse-namestring n) ext))
  30. (defmethod has-extension ((p pathname) ext)
  31. "Probably should use CL's PATHNAME methods , but simply looking at the .XXX portion of a filename
  32. to see if it matches. PATHNAME version."
  33. (let ((e (pathname-type p)))
  34. (if e
  35. (string= (string-downcase e) (string-downcase ext))
  36. nil)))