diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-04-19 22:05:42 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-04-21 15:58:41 +0200 |
| commit | 28c891215a6e24eba3a94700554da0dd9c2d79b6 (patch) | |
| tree | b126b3bdd726df8bc95f2e1c43e7d719e3397d8c | |
| parent | Split WebDAV calendar resources into 2. (diff) | |
| download | calp-28c891215a6e24eba3a94700554da0dd9c2d79b6.tar.gz calp-28c891215a6e24eba3a94700554da0dd9c2d79b6.tar.xz | |
Add href-relative.
| -rw-r--r-- | module/calp/webdav/resource/base.scm | 9 |
1 files changed, 9 insertions, 0 deletions
diff --git a/module/calp/webdav/resource/base.scm b/module/calp/webdav/resource/base.scm index 95e9ad43..500aef90 100644 --- a/module/calp/webdav/resource/base.scm +++ b/module/calp/webdav/resource/base.scm @@ -17,6 +17,7 @@ ;; href href->string string->href + href-relative ;; local-path name dead-properties @@ -150,6 +151,14 @@ (remove string-null? (string-split s #\/))) +;; parent must be the head of child, elements in child after that is "free range" +(define (href-relative parent child) + (cond ((null? parent) child) + ((null? child) (scm-error 'misc-error "href-relative" "Not a sub-href" '() #f)) + ((equal? (car parent) (car child)) + (href-relative (cdr parent) (cdr child))) + (else (scm-error 'misc-error "href-relative" "Not a sub-href" '() #f)))) + (define-method (children (self <resource>)) (resource-children self)) |