diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2021-12-21 16:17:28 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2021-12-22 22:58:30 +0100 |
commit | d00fea566004e67161ee45246b239fff5d416b0e (patch) | |
tree | 5641c0c0d0e78b046b6045ed2440512f12259560 /module/vcomponent | |
parent | Complete rewrite of use2dot (diff) | |
download | calp-d00fea566004e67161ee45246b239fff5d416b0e.tar.gz calp-d00fea566004e67161ee45246b239fff5d416b0e.tar.xz |
Cleanup modules.
Primarly this moves all vcompenent input and output code to clearly
labeled modules, instead of being spread out. At the same time it also
removes a handfull of unused procedures.
Diffstat (limited to 'module/vcomponent')
-rw-r--r-- | module/vcomponent/base.scm | 10 | ||||
-rw-r--r-- | module/vcomponent/build.scm | 38 | ||||
-rw-r--r-- | module/vcomponent/control.scm | 2 | ||||
-rw-r--r-- | module/vcomponent/formats/common/types.scm (renamed from module/vcomponent/parse/types.scm) | 5 | ||||
-rw-r--r-- | module/vcomponent/formats/ical/output.scm (renamed from module/vcomponent/ical/output.scm) | 50 | ||||
-rw-r--r-- | module/vcomponent/formats/ical/parse.scm (renamed from module/vcomponent/ical/parse.scm) | 12 | ||||
-rw-r--r-- | module/vcomponent/formats/ical/types.scm (renamed from module/vcomponent/ical/types.scm) | 8 | ||||
-rw-r--r-- | module/vcomponent/formats/vdir/parse.scm (renamed from module/vcomponent/vdir/parse.scm) | 6 | ||||
-rw-r--r-- | module/vcomponent/formats/vdir/save-delete.scm (renamed from module/vcomponent/vdir/save-delete.scm) | 4 | ||||
-rw-r--r-- | module/vcomponent/formats/xcal/output.scm (renamed from module/vcomponent/xcal/output.scm) | 4 | ||||
-rw-r--r-- | module/vcomponent/formats/xcal/parse.scm (renamed from module/vcomponent/xcal/parse.scm) | 4 | ||||
-rw-r--r-- | module/vcomponent/formats/xcal/types.scm (renamed from module/vcomponent/xcal/types.scm) | 6 | ||||
-rw-r--r-- | module/vcomponent/util/control.scm | 36 | ||||
-rw-r--r-- | module/vcomponent/util/describe.scm (renamed from module/vcomponent/describe.scm) | 4 | ||||
-rw-r--r-- | module/vcomponent/util/group.scm (renamed from module/vcomponent/group.scm) | 2 | ||||
-rw-r--r-- | module/vcomponent/util/instance.scm (renamed from module/vcomponent/instance.scm) | 6 | ||||
-rw-r--r-- | module/vcomponent/util/instance/methods.scm (renamed from module/vcomponent/instance/methods.scm) | 5 | ||||
-rw-r--r-- | module/vcomponent/util/parse-cal-path.scm (renamed from module/vcomponent/parse.scm) | 12 | ||||
-rw-r--r-- | module/vcomponent/util/search.scm (renamed from module/vcomponent/search.scm) | 2 |
19 files changed, 89 insertions, 127 deletions
diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm index ab2121a2..66e6534f 100644 --- a/module/vcomponent/base.scm +++ b/module/vcomponent/base.scm @@ -85,9 +85,6 @@ => (lambda (vline) (set-vline-value! vline value))] [else (hashq-set! ht key (make-vline key value))]))) -(define-public (set-vline! component key vline) - (hashq-set! (get-component-properties component) - key vline)) @@ -158,9 +155,6 @@ (define-public (properties component) (hash-map->list cons (get-component-properties component))) -(define-public (property-keys component) - (hash-map->list (lambda (a _) a) (get-component-properties component))) - (define (copy-vline vline) (make-vline (vline-key vline) (get-vline-value vline) @@ -186,10 +180,6 @@ (define-public (extract* field) (lambda (e) (prop* e field))) -(define-public (key=? k1 k2) - (eq? (as-symb k1) - (as-symb k2))) - (define-public (x-property? symb) (string=? "X-" (string-take (symbol->string symb) 2))) diff --git a/module/vcomponent/build.scm b/module/vcomponent/build.scm deleted file mode 100644 index d49844cc..00000000 --- a/module/vcomponent/build.scm +++ /dev/null @@ -1,38 +0,0 @@ -;;; Commentary: -;; Module for quickly building new vcomponents from code. -;; @example -;; (vevent -;; summary: "This is a test event" -;; dtstart: #2020-01-01T13:37:00 -;; children: (list -;; (valarm ...))) -;;; Code: - -(define-module (vcomponent build) - :use-module (calp util) - :use-module (vcomponent base) - :use-module (srfi srfi-26) - :use-module ((srfi srfi-88) :select (keyword->string))) - -(define-public (vevent . body) (apply vcomponent 'VEVENT body)) -(define-public (vcalendar . body) (apply vcomponent 'VCALENDAR body)) -(define-public (valarm . body) (apply vcomponent 'VALARM body)) - -(define-public (vcomponent tag . rest) - (define v (make-vcomponent tag)) - - (let loop ((rem rest)) - (unless (null? rem) - (if (eq? children: (car rem)) - (for-each (cut add-child! v <>) (cadr rem)) - (let ((symb (-> (car rem) - keyword->string - string-upcase - string->symbol))) - (set! (prop v symb) (cadr rem)))) - (loop (cddr rem)))) - - ;; Return - v) - - diff --git a/module/vcomponent/control.scm b/module/vcomponent/control.scm index 5fe5b8b0..4cb6c708 100644 --- a/module/vcomponent/control.scm +++ b/module/vcomponent/control.scm @@ -1,4 +1,4 @@ -(define-module (vcomponent control) +(define-module (vcomponent util control) #:use-module (calp util) #:use-module (vcomponent) #:export (with-replaced-properties)) diff --git a/module/vcomponent/parse/types.scm b/module/vcomponent/formats/common/types.scm index ba4b2b47..87425c01 100644 --- a/module/vcomponent/parse/types.scm +++ b/module/vcomponent/formats/common/types.scm @@ -1,9 +1,10 @@ -(define-module (vcomponent parse types) +(define-module (vcomponent formats common types) :use-module (calp util) :use-module (calp util exceptions) :use-module (base64) :use-module (datetime) :use-module (srfi srfi-9 gnu) + :use-module (datetime timespec) ) ;; BINARY @@ -103,8 +104,6 @@ (define (parse-uri props value) value) -(use-modules (datetime timespec)) - ;; UTC-OFFSET (define (parse-utc-offset props value) (make-timespec diff --git a/module/vcomponent/ical/output.scm b/module/vcomponent/formats/ical/output.scm index bcc6bb1d..9efac3c4 100644 --- a/module/vcomponent/ical/output.scm +++ b/module/vcomponent/formats/ical/output.scm @@ -1,21 +1,21 @@ -(define-module (vcomponent ical output) +(define-module (vcomponent formats ical output) + :use-module (calp util exceptions) + :use-module (calp util) + :use-module (datetime) + :use-module (datetime zic) + :use-module ((datetime instance) :select (zoneinfo)) + :use-module (glob) :use-module (ice-9 format) :use-module (ice-9 match) - :use-module (calp util) - :use-module (calp util exceptions) - :use-module (vcomponent) - :use-module (vcomponent datetime) :use-module (srfi srfi-1) - :use-module (datetime) :use-module (srfi srfi-41) :use-module (srfi srfi-41 util) - :use-module (datetime zic) - :use-module (glob) - :use-module (vcomponent recurrence) + :use-module (vcomponent) + :use-module (vcomponent datetime) :use-module (vcomponent geo) - :use-module (vcomponent ical types) - :autoload (vcomponent instance) (global-event-object) - :use-module ((datetime instance) :select (zoneinfo)) + :use-module (vcomponent formats ical types) + :use-module (vcomponent recurrence) + :autoload (vcomponent util instance) (global-event-object) ) (define (prodid) @@ -165,32 +165,6 @@ => (lambda (alts) (hash-map->list (lambda (_ comp) (component->ical-string comp)) alts))])) -;; TODO tzid param on dtstart vs tz field in datetime object -;; TODO remove this, replace with methods from (output vdir) -;; how do we keep these two in sync? -(define (write-event-to-file event calendar-path) - (define cal (make-vcomponent 'VCALENDAR)) - - (set! (prop cal 'PRODID) (prodid) - (prop cal 'VERSION) "2.0" - (prop cal 'CALSCALE) "GREGORIAN") - - (add-child! cal event) - - (awhen (and (provided? 'zoneinfo) - (param (prop* event 'DTSTART) 'TZID)) - ;; TODO this is broken - (add-child! cal (zoneinfo->vtimezone (zoneinfo) it))) - - (unless (prop event 'UID) - (set! (prop event 'UID) - (uuidgen))) - - (with-output-to-file (glob (format #f "~a/~a.ics" - calendar-path - (prop event 'UID))) - (lambda () (component->ical-string cal)))) - (define (print-header) diff --git a/module/vcomponent/ical/parse.scm b/module/vcomponent/formats/ical/parse.scm index b67ae593..d76044a3 100644 --- a/module/vcomponent/ical/parse.scm +++ b/module/vcomponent/formats/ical/parse.scm @@ -1,14 +1,14 @@ -(define-module (vcomponent ical parse) - :use-module (calp util) - :use-module (calp util exceptions) +(define-module (vcomponent formats ical parse) :use-module ((ice-9 rdelim) :select (read-line)) - :use-module (vcomponent base) + :use-module (calp util exceptions) + :use-module (calp util) :use-module (datetime) :use-module (srfi srfi-1) - :use-module (srfi srfi-9 gnu) :use-module (srfi srfi-26) - :use-module (vcomponent parse types) + :use-module (srfi srfi-9 gnu) + :use-module (vcomponent base) :use-module (vcomponent geo) + :use-module (vcomponent formats common types) ) (define string->symbol diff --git a/module/vcomponent/ical/types.scm b/module/vcomponent/formats/ical/types.scm index 1ec9d0bd..d063ca8f 100644 --- a/module/vcomponent/ical/types.scm +++ b/module/vcomponent/formats/ical/types.scm @@ -1,10 +1,12 @@ ;; see (vcomponent parse types) -(define-module (vcomponent ical types) +(define-module (vcomponent formats ical types) :use-module (calp util) :use-module (calp util exceptions) :use-module (base64) - :use-module (datetime)) + :use-module (datetime) + :use-module (datetime timespec)) +;; TODO shouldn't these really take vline:s? (define (write-binary _ value) (bytevector->base64-string value)) @@ -62,8 +64,6 @@ value) -(use-modules (datetime timespec)) - (define (write-utc-offset _ value) (with-output-to-string (lambda () diff --git a/module/vcomponent/vdir/parse.scm b/module/vcomponent/formats/vdir/parse.scm index 6bbd1329..f3810887 100644 --- a/module/vcomponent/vdir/parse.scm +++ b/module/vcomponent/formats/vdir/parse.scm @@ -1,10 +1,10 @@ ;;; Commentary: ;; Code for parsing vdir's and icalendar files. ;; This module handles the finding of files, while -;; (vcomponent parse ical) handles reading data from icalendar files. +;; (vcomponent formats parse ical) handles reading data from icalendar files. ;;; Code: -(define-module (vcomponent vdir parse) +(define-module (vcomponent formats vdir parse) :use-module (srfi srfi-1) :use-module ((ice-9 hash-table) :select (alist->hash-table)) @@ -15,7 +15,7 @@ :use-module (calp util exceptions) :use-module (vcomponent base) - :use-module (vcomponent ical parse) + :use-module (vcomponent formats ical parse) ) diff --git a/module/vcomponent/vdir/save-delete.scm b/module/vcomponent/formats/vdir/save-delete.scm index b3c7f9c5..1c70dabf 100644 --- a/module/vcomponent/vdir/save-delete.scm +++ b/module/vcomponent/formats/vdir/save-delete.scm @@ -9,10 +9,10 @@ ;;; Code: -(define-module (vcomponent vdir save-delete) +(define-module (vcomponent formats vdir save-delete) :use-module (calp util) :use-module ((calp util exceptions) :select (assert)) - :use-module (vcomponent ical output) + :use-module (vcomponent formats ical output) :use-module (vcomponent) :use-module ((calp util io) :select (with-atomic-output-to-file)) ) diff --git a/module/vcomponent/xcal/output.scm b/module/vcomponent/formats/xcal/output.scm index 70288cba..e2cada83 100644 --- a/module/vcomponent/xcal/output.scm +++ b/module/vcomponent/formats/xcal/output.scm @@ -1,9 +1,9 @@ -(define-module (vcomponent xcal output) +(define-module (vcomponent formats xcal output) :use-module (calp util) :use-module (calp util exceptions) :use-module (vcomponent) :use-module (vcomponent geo) - :use-module (vcomponent xcal types) + :use-module (vcomponent formats xcal types) :use-module (ice-9 match) :use-module (datetime) :use-module (srfi srfi-1) diff --git a/module/vcomponent/xcal/parse.scm b/module/vcomponent/formats/xcal/parse.scm index c6a2122f..e84f380e 100644 --- a/module/vcomponent/xcal/parse.scm +++ b/module/vcomponent/formats/xcal/parse.scm @@ -1,4 +1,4 @@ -(define-module (vcomponent xcal parse) +(define-module (vcomponent formats xcal parse) :use-module (calp util) :use-module (calp util exceptions) :use-module (base64) @@ -6,7 +6,7 @@ :use-module (sxml match) :use-module (vcomponent) :use-module (vcomponent geo) - :use-module (vcomponent parse types) + :use-module (vcomponent formats common types) :use-module (datetime) :use-module (srfi srfi-1) ) diff --git a/module/vcomponent/xcal/types.scm b/module/vcomponent/formats/xcal/types.scm index 468400f4..34c7c40d 100644 --- a/module/vcomponent/xcal/types.scm +++ b/module/vcomponent/formats/xcal/types.scm @@ -1,6 +1,6 @@ -(define-module (vcomponent xcal types) +(define-module (vcomponent formats xcal types) :use-module (calp util) - :use-module (vcomponent ical types) + :use-module (vcomponent formats ical types) :use-module (datetime) ) @@ -40,7 +40,7 @@ (hashq-set! sxml-writers simple-type (lambda (p v) `(,(downcase-symbol simple-type) - ,(((@ (vcomponent ical types) get-writer) simple-type) p v))))) + ,(((@ (vcomponent formats ical types) get-writer) simple-type) p v))))) (hashq-set! sxml-writers 'BOOLEAN write-boolean) (hashq-set! sxml-writers 'DATE write-date) diff --git a/module/vcomponent/util/control.scm b/module/vcomponent/util/control.scm new file mode 100644 index 00000000..4cb6c708 --- /dev/null +++ b/module/vcomponent/util/control.scm @@ -0,0 +1,36 @@ +(define-module (vcomponent util control) + #:use-module (calp util) + #:use-module (vcomponent) + #:export (with-replaced-properties)) + + +(eval-when (expand load) ; No idea why I must have load here. + (define href (make-procedure-with-setter hash-ref hash-set!)) + + (define (set-temp-values! table component kvs) + (for-each (lambda (kv) + (let* (((key val) kv)) + (when (prop component key) + (set! (href table key) (prop component key)) + (set! (prop component key) val)))) + kvs)) + + (define (restore-values! table component keys) + (for-each (lambda (key) + (and=> (href table key) + (lambda (val) + (set! (prop component key) val)))) + keys))) + +;; TODO what is this even used for? +(define-syntax with-replaced-properties + (syntax-rules () + [(_ (component (key val) ...) + body ...) + + (let ((htable (make-hash-table 10))) + (dynamic-wind + (lambda () (set-temp-values! htable component (quote ((key val) ...)))) ; In guard + (lambda () body ...) + (lambda () (restore-values! htable component (quote (key ...))))))])) ; Out guard + diff --git a/module/vcomponent/describe.scm b/module/vcomponent/util/describe.scm index af0f9433..5c3afd30 100644 --- a/module/vcomponent/describe.scm +++ b/module/vcomponent/util/describe.scm @@ -1,4 +1,4 @@ -(define-module (vcomponent describe) +(define-module (vcomponent util describe) :use-module (calp util) :use-module (vcomponent base) :use-module (text util)) @@ -23,7 +23,7 @@ (format #f "~a" (value vline)) (- 80 indent maxlen))) (awhen (vline-source vline) - (display ((@@ (vcomponent ical parse) get-line) it))) + (display ((@@ (vcomponent formats ical parse) get-line) it))) (unless (null? (parameters vline)) (display " ;") (for (key value) in (parameters vline) diff --git a/module/vcomponent/group.scm b/module/vcomponent/util/group.scm index d23787ef..f328cd18 100644 --- a/module/vcomponent/group.scm +++ b/module/vcomponent/util/group.scm @@ -1,4 +1,4 @@ -(define-module (vcomponent group) +(define-module (vcomponent util group) #:use-module (vcomponent) #:use-module (vcomponent datetime) #:use-module (datetime) diff --git a/module/vcomponent/instance.scm b/module/vcomponent/util/instance.scm index 206d7f19..15c020b1 100644 --- a/module/vcomponent/instance.scm +++ b/module/vcomponent/util/instance.scm @@ -1,4 +1,4 @@ -(define-module (vcomponent instance) +(define-module (vcomponent util instance) :use-module (calp util) :use-module ((calp util config) :select (get-config)) :use-module ((oop goops) :select (make)) @@ -12,11 +12,11 @@ ;; TODO this is loaded on compile, meaning that Guile's auto-compiler may ;; evaluate this to early. (define-once global-event-object - (make (@@ (vcomponent instance methods) <events>) + (make (@@ (vcomponent util instance methods) <events>) calendar-files: (get-config 'calendar-files))) (define-public (reload) - (let ((new-value (make (@@ (vcomponent instance methods) <events>) + (let ((new-value (make (@@ (vcomponent util instance methods) <events>) calendar-files: (get-config 'calendar-files)))) (display "Reload done\n" (current-error-port)) (set! global-event-object new-value))) diff --git a/module/vcomponent/instance/methods.scm b/module/vcomponent/util/instance/methods.scm index 414587a9..37aef3bc 100644 --- a/module/vcomponent/instance/methods.scm +++ b/module/vcomponent/util/instance/methods.scm @@ -1,11 +1,12 @@ -(define-module (vcomponent instance methods) +(define-module (vcomponent util instance methods) :use-module (calp util) :use-module (srfi srfi-1) :use-module (srfi srfi-41) :use-module (srfi srfi-41 util) :use-module (datetime) :use-module (vcomponent base) - :use-module (vcomponent parse) + ;; :use-module (vcomponent parse) + :use-module ((vcomponent util parse-cal-path) :select (parse-cal-path)) :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?)) :use-module ((vcomponent datetime) :select (ev-time<?)) :use-module (oop goops) diff --git a/module/vcomponent/parse.scm b/module/vcomponent/util/parse-cal-path.scm index 9790d1eb..94c0c6ed 100644 --- a/module/vcomponent/parse.scm +++ b/module/vcomponent/util/parse-cal-path.scm @@ -1,12 +1,12 @@ -(define-module (vcomponent parse) +(define-module (vcomponent util parse-cal-path) :use-module (calp util) - :use-module (vcomponent base) - :use-module ((vcomponent vdir parse) :select (parse-vdir)) :use-module ((calp util time) :select (report-time!)) + :use-module (vcomponent base) + :use-module ((vcomponent formats ical parse) + :select (parse-calendar)) + :use-module ((vcomponent formats vdir parse) + :select (parse-vdir))) - :use-module (vcomponent ical parse) - :re-export (parse-calendar) - ) ;; Parse a vdir or ics file at the given path. (define-public (parse-cal-path path) diff --git a/module/vcomponent/search.scm b/module/vcomponent/util/search.scm index a850fb40..fb395022 100644 --- a/module/vcomponent/search.scm +++ b/module/vcomponent/util/search.scm @@ -24,7 +24,7 @@ ;;; Code: -(define-module (vcomponent search) +(define-module (vcomponent util search) :use-module (calp util) :use-module (srfi srfi-1) :use-module (srfi srfi-9) |