;; Copyright (C) 2008-2013 Tommi Höynälänmaa
;; Distributed under GNU General Public License version 3,
;; see file doc/GPL-3.


;; *** Theme file handling ***


;; (import (rnrs exceptions)
;; 	(rnrs io simple)
;; 	(srfi srfi-35)
;; 	(th-scheme-utilities stdutils)
;; 	(th-scheme-utilities hrecord))


(import (rnrs exceptions)
 	(rnrs io simple)
 	(srfi srfi-35))


(define-condition-type &theme-file-exception &condition
  theme-file-exception?
  (type theme-file-exception-type)
  (filename theme-file-exception-filename))


(define (make-file-exception type filename)
  (make-condition &theme-file-exception 'type type 'filename filename))


(define (theme-open-input-file filename)
  (guard (exc (else
	       (raise (make-file-exception
		       'error-opening-input-file filename))))
	 (open-input-file filename)))


(define (theme-open-output-file filename)
  (guard (exc (else
	       (raise (make-file-exception
		       'error-opening-output-file filename))))
	 ;; Procedure open-output-file raises an exception if the file
	 ;; already exists (?).
	 (if (file-exists? filename) (delete-file filename))
	 (open-output-file filename)))


(define (theme-close-input-port port)
  (guard (exc (else
	       (raise (make-file-exception
		       'error-closing-input-file
		       (i/o-error-filename exc)))))
	 (close-input-port port)))


(define (theme-close-output-port port)
  (guard (exc (else
	       (raise (make-file-exception
		       'error-closing-output-file
		       (i/o-error-filename exc)))))
	 (close-output-port port)))


(define (theme-read port)
  (guard (exc (else
	       (raise (make-file-exception
		       'error-reading-file
		       (i/o-error-filename exc)))))
	 (read port)))


(define (theme-read-file port)
  (guard (exc (else
	       (raise (make-file-exception
		       'error-reading-file
		       (i/o-error-filename exc)))))
	 (read-file port)))
