File: theme-d-file-handling.scm

package info (click to toggle)
theme-d 1.4.0-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 12,784 kB
  • sloc: lisp: 47,684; sh: 4,200; makefile: 455; ansic: 319
file content (77 lines) | stat: -rw-r--r-- 1,891 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
;; 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)))