summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xbin/tissue10
-rw-r--r--tissue/git.scm8
2 files changed, 12 insertions, 6 deletions
diff --git a/bin/tissue b/bin/tissue
index 1dab955..946a240 100755
--- a/bin/tissue
+++ b/bin/tissue
@@ -222,12 +222,10 @@ Export the repository as a website to OUTPUT-DIRECTORY.
(state-directory . "/var/lib/tissue")
;; Assume current repository as default. If there is no current
;; repository, do not configure any hosts.
- (hosts . ,(guard (c ((and (irritants-condition? c)
- (match (condition-irritants c)
- ((git-error _ ...)
- (= (git-error-code git-error)
- GIT_ENOTFOUND))
- (_ #f)))
+ (hosts . ,(guard (c ((let ((git-error (condition-git-error c)))
+ (and git-error
+ (= (git-error-code git-error)
+ GIT_ENOTFOUND)))
'()))
`(("localhost"
(upstream-repository . ,(git-top-level))))))))
diff --git a/tissue/git.scm b/tissue/git.scm
index 7f61785..024ebb6 100644
--- a/tissue/git.scm
+++ b/tissue/git.scm
@@ -18,8 +18,10 @@
(define-module (tissue git)
#:use-module (rnrs arithmetic bitwise)
+ #:use-module (rnrs conditions)
#:use-module (rnrs hashtables)
#:use-module (rnrs io ports)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
@@ -35,6 +37,7 @@
#:use-module (tissue utils)
#:export (reference-set-target!
reference-symbolic-target
+ condition-git-error
git-top-level
%current-git-repository
current-git-repository
@@ -71,6 +74,11 @@
(pointer->string
(proc (reference->pointer reference))))))
+(define (condition-git-error condition)
+ "Return <git-error> object from CONDITION. If none, return #f."
+ (and (irritants-condition? condition)
+ (find git-error? (condition-irritants condition))))
+
(define %current-git-repository
(make-parameter #f))