logging.scm 1.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748
  1. ;;; Disarchive
  2. ;;; Copyright © 2020, 2021 Timothy Sample <samplet@ngyro.com>
  3. ;;;
  4. ;;; This file is part of Disarchive.
  5. ;;;
  6. ;;; Disarchive is free software: you can redistribute it and/or modify
  7. ;;; it under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation, either version 3 of the License, or
  9. ;;; (at your option) any later version.
  10. ;;;
  11. ;;; Disarchive is distributed in the hope that it will be useful,
  12. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;;; GNU General Public License for more details.
  15. ;;;
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Disarchive. If not, see <http://www.gnu.org/licenses/>.
  18. (define-module (disarchive logging)
  19. #:export (%disarchive-log-port
  20. message
  21. start-message
  22. without-logging))
  23. ;;; Commentary:
  24. ;;;
  25. ;;; This module provides a simple logging interface.
  26. ;;;
  27. ;;; Code:
  28. (define %disarchive-log-port (make-parameter #f))
  29. (define-syntax-rule (message format-string value ...)
  30. (let ((port (%disarchive-log-port)))
  31. (when port
  32. (format port format-string value ...)
  33. (newline port))))
  34. (define-syntax-rule (start-message format-string value ...)
  35. (let ((port (%disarchive-log-port)))
  36. (when port
  37. (format port format-string value ...)
  38. (force-output port))))
  39. (define-syntax-rule (without-logging body ...)
  40. (parameterize ((%disarchive-log-port (%make-void-port "w")))
  41. body ...))