[Implement scsh `with-errno-handler'
clinton@unknownlamer.org**20100331185224
 Ignore-this: 4e7003456ce7268cc9714e2429401081
] addfile ./module/scsh/system-error.scm
hunk ./module/scsh/system-error.scm 1
+;;; scsh system error interface (part of Guile Facacde)
+;;; Copyright (c) 2010 Clinton Ebadi
+
+;;; Implements the scsh/scsh-condition interface, but is a
+;;; reimplementation from documentation (none of the scsh code was
+;;; really applicable to Guile).
+
+(define-module (scsh system-error)
+  #:export (with-errno-handler
+	    with-errno-handler*))
+
+(define (with-errno-handler* handler thunk)
+  (catch 'system-error
+    thunk
+    (lambda (key syscall format-string format-args errno)
+      (let ((errno (car errno)))
+	(handler errno (list (apply format #f format-string format-args)
+			     syscall
+			     #f)))))) ; does not provide data
+				      ; argument... not entirely sure
+				      ; what the possible values are
+				      ; "...and data is a list of
+				      ; information generated by the
+				      ; error, which varies from
+				      ; syscall to syscall."
+
+;;; docs specify clause syntax as ((errno ...) body ...), but it makes
+;;; little sense to allow zero of either and and so at least one is
+;;; enforced
+(define-syntax with-errno-handler
+  (lambda (x)
+    (syntax-case x ()
+      ((_ ((errno packet) clause ...) body1 body2 ...)
+       (with-syntax (((handler-cases ...)
+		      (map (lambda (clause)
+			     (syntax-case clause (else)
+			       (((error1 error2 ...) expr1 expr2 ...)
+				(syntax ((memv errno (list error1 error2 ...))
+					 expr1 expr2 ...)))
+			       ((else expr1 expr2 ...)
+				(syntax (else expr1 expr2 ...)))))
+			   (syntax (clause ...)))))
+	 (syntax (with-errno-handler* (lambda (errno packet)
+					(cond handler-cases ...))
+				      (lambda ()
+					body1 body2 ...))))))))
+