Move C and Scheme code into subdirs.

8 files changed, 0 insertions, 459 deletions

diff --git a/vcalendar/control.scm b/vcalendar/control.scm
deleted file mode 100644
index a38d678f..00000000
--- a/vcalendar/control.scm
+++ /dev/null
@@ -1,39 +0,0 @@
-(define-module (vcalendar control)
-  #:use-module (util)
-  #:use-module (vcalendar)
-  #:export (with-replaced-attrs))
-
-
-(eval-when (expand load)                ; No idea why I must have load here.
-  (define href (make-procedure-with-setter hashq-ref hashq-set!))
-
-  (define (set-temp-values! table component kvs)
-    (for-each (lambda (kv)
-                (let* (((key val) kv))
-                  (when (attr component key)
-                    (set! (href table key) (attr component key))
-                    (set! (attr component key) val))))
-              kvs))
-
-  (define (restore-values! table component keys)
-    (for-each (lambda (key)
-                (and=> (href table key)
-                       (lambda (val)
-                         (set! (attr component key) val))))
-              keys)))
-
-;;; TODO with-added-attributes
-
-(define-syntax with-replaced-attrs
-  (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
-
-;;; TODO test that restore works, at all
-;;; Test that non-local exit and return works
diff --git a/vcalendar/datetime.scm b/vcalendar/datetime.scm
deleted file mode 100644
index 360b8348..00000000
--- a/vcalendar/datetime.scm
+++ /dev/null
@@ -1,34 +0,0 @@
-(define-module (vcalendar datetime)
-  #:use-module (vcalendar)
-  #:use-module (srfi srfi-19)
-  #:use-module (srfi srfi-19 util)
-
-  #:export (parse-datetime
-            event-overlaps?
-            event-in?)
-  )
-
-(define (parse-datetime dtime)
-  "Parse the given date[time] string into a date object."
-  ;; localize-date
-  (date->time-utc
-   (string->date
-    dtime
-    (case (string-length dtime)
-      ((8) "~Y~m~d")
-      ((15) "~Y~m~dT~H~M~S")
-      ((16) "~Y~m~dT~H~M~S~z")))))
-
-(define (event-overlaps? event begin end)
-  "Returns if the event overlaps the timespan.
-Event must have the DTSTART and DTEND attribute set."
-  (timespan-overlaps? (attr event 'DTSTART)
-                      (attr event 'DTEND)
-                      begin end))
-
-(define (event-in? ev time)
-  "Does event overlap the date that contains time."
-  (let* ((date (time-utc->date time))
-         (start (date->time-utc (drop-time date)))
-         (end (add-duration start (make-duration (* 60 60 24)))))
-    (event-overlaps? ev start end)))
diff --git a/vcalendar/output.scm b/vcalendar/output.scm
deleted file mode 100644
index e4635beb..00000000
--- a/vcalendar/output.scm
+++ /dev/null
@@ -1,93 +0,0 @@
-(define-module (vcalendar output)
-  #:use-module (vcalendar)
-  #:use-module (vcalendar control)
-  #:use-module (util)
-  #:use-module (srfi srfi-19 util)
-  #:use-module (srfi srfi-26)
-  #:export (print-vcomponent
-            serialize-vcomponent
-            color-if
-            STR-YELLOW STR-RESET))
-
-(define STR-YELLOW "\x1b[0;33m")
-(define STR-RESET "\x1b[m")
-
-(define-syntax-rule (color-if pred color body ...)
-  (let ((pred-value pred))
-    (format #f "~a~a~a"
-            (if pred-value color "")
-            (begin body ...)
-            (if pred-value STR-RESET ""))))
-
-(define* (print-vcomponent comp #:optional (depth 0))
-  (let ((kvs (map (lambda (key) (cons key (attr comp key)))
-                  (attributes comp))))
-    (format #t "~a <~a> :: ~:a~%"
-            (make-string depth #\:)
-            (type comp) comp)
-    (for-each-in kvs
-                 (lambda (kv)
-                   (let ((key (car kv))
-                         (value (cdr kv)))
-                     (format #t "~a ~20@a: ~a~%"
-                             (make-string depth #\:)
-                             key value))))
-    (for-each-in (children comp)
-                 (cut print-vcomponent <> (1+ depth)))))
-
-
-
-;;; TODO
-;; Error in CREATED /home/hugo/.calendars/b85ba2e9-18aa-4451-91bb-b52da930e977/a1a25238-d63d-46a1-87fd-d0c9334a7a30CalSync.ics:
-;; Wrong type argument in position 1 (expecting string): ("20180118T124015Z" "VALARM")
-
-(define (string->ics-safe-string str)
-  "TODO wrap at 75(?) columns."
-  (define (escape char)
-    (string #\\ char))
-
-  (string-concatenate
-   (map (lambda (c)
-          (case c
-            ((#\newline) "\\n")
-            ((#\, #\; #\\) => escape)
-            (else => string)))
-        (string->list str))))
-
-;;; TODO parameters ( ;KEY=val: )
-(define* (serialize-vcomponent comp #:optional (port (current-output-port)))
-  "Recursively write a component back to its ICS form.
-Removes the X-HNH-FILENAME attribute, and sets PRODID to
-\"HugoNikanor-calparse\" in the output."
-  (with-replaced-attrs
-   (comp (prodid "HugoNikanor-calparse"))
-
-   (format port "BEGIN:~a~%" (type comp))
-   (let ((kvs (map (lambda (key) (list key (attr comp key)))
-                   (filter (negate (cut key=? <> 'X-HNH-FILENAME))
-                           (attributes comp)))))
-     (for-each-in
-      kvs (lambda (kv)
-            (let* (((key value) kv))
-              (catch 'wrong-type-arg
-                (lambda ()
-                  (format port "~a:~a~%" key
-                          (string->ics-safe-string
-                           (case key
-                             ((DTSTART DTEND)
-                              (if (string? value)
-                                  value
-                                  (time->string value "~Y~m~dT~H~M~S")))
-
-                             ((RRULE DURATION) "Just forget it")
-
-                             (else value)))))
-
-                ;; Catch
-                (lambda (type proc fmt . args)
-                  (apply format (current-error-port) "[ERR] ~a in ~a (~a) ~a:~%~?~%"
-                         type key proc (attr comp 'X-HNH-FILENAME)
-                         fmt args))))))
-
-     (for-each (cut serialize-vcomponent <> port) (children comp)))
-   (format port "END:~a~%" (type comp))))
diff --git a/vcalendar/primitive.scm b/vcalendar/primitive.scm
deleted file mode 100644
index fdce550c..00000000
--- a/vcalendar/primitive.scm
+++ /dev/null
@@ -1,21 +0,0 @@
-;;; Primitive export of symbols linked from C binary.
-
-(define-module (vcalendar primitive)
-  #:export (%vcomponent-children
-            %vcomponent-push-child!
-            %vcomponent-filter-children!
-
-            %vcomponent-parent
-
-            %vcomponent-make
-            %vcomponent-type
-
-            %vcomponent-set-attribute!
-            %vcomponent-get-attribute
-
-            %vcomponent-attribute-list
-
-            %vcomponent-shallow-copy))
-
-(setenv "LD_LIBRARY_PATH" (dirname (dirname (current-filename))))
-(load-extension "libguile-calendar" "init_lib")
diff --git a/vcalendar/recur.scm b/vcalendar/recur.scm
deleted file mode 100644
index 3657cae6..00000000
--- a/vcalendar/recur.scm
+++ /dev/null
@@ -1,12 +0,0 @@
-(define-module (vcalendar recur)
-  #:use-module (vcalendar)
-  #:use-module (vcalendar recurrence generate)
-  #:re-export (generate-recurrence-set)
-  #:export (repeating?))
-
-;; EXDATE is also a property linked to recurense rules
-;; but that property alone don't create a recuring event.
-(define (repeating? ev)
-  "Does this event repeat?"
-  (or (attr ev 'RRULE)
-      (attr ev 'RDATE)))
diff --git a/vcalendar/recurrence/generate.scm b/vcalendar/recurrence/generate.scm
deleted file mode 100644
index fae404ec..00000000
--- a/vcalendar/recurrence/generate.scm
+++ /dev/null
@@ -1,126 +0,0 @@
-(define-module (vcalendar recurrence generate)
-  ;; #:use-module (srfi srfi-1)
-  ;; #:use-module (srfi srfi-9 gnu)        ; Records
-  #:use-module (srfi srfi-19)           ; Datetime
-  #:use-module (srfi srfi-19 util)
-
-  #:use-module (srfi srfi-26)           ; Cut
-  #:use-module (srfi srfi-41)           ; Streams
-  ;; #:use-module (ice-9 control)          ; call-with-escape-continuation
-  #:use-module (ice-9 match)
-  #:use-module (vcalendar)
-  #:use-module (vcalendar datetime)
-  #:use-module (util)
-
-  #:use-module (vcalendar recurrence internal)
-  #:use-module (vcalendar recurrence parse)
-
-  #:export (generate-recurrence-set)
-  )
-
-;;; TODO implement
-;;; EXDATE and RDATE
-
-;;; EXDATE (3.8.5.1)
-;;; comma sepparated list of dates or datetimes.
-;;; Can have TZID parameter
-;;; Specifies list of dates that the event should not happen on, even
-;;; if the RRULE say so.
-;;; Can have VALUE field specifiying "DATE-TIME" or "DATE".
-
-;;; RDATE (3.8.5.2)
-;;; Comma sepparated list of dates the event should happen on.
-;;; Can have TZID parameter.
-;;; Can have VALUE parameter, specyfying "DATE-TIME", "DATE" or "PREIOD".
-;;; PERIOD (see 3.3.9)
-
-(define (seconds-in freq)
-  (case freq
-    ((SECONDLY) 1)
-    ((MINUTELY) 60)
-    ((HOURLY) (* 60 60))
-    ((DAILY) (* 60 60 24))
-    ((WEEKLY) (* 60 60 24 7))))
-
-
-;; BYDAY and the like depend on the freq?
-;; Line 7100
-;; Table @@ 2430
-;; 
-;; Event x Rule → Bool (continue?)
-;; Alternative, monadic solution using <optional>.
-;; @example
-;; (optional->bool
-;;  (do (<$> (cut time<=? (attr last 'DTSTART)) (until r))
-;;      (<$> (negate zero?) (count r))
-;;    (just #t)))
-;; @end example
-(define-stream (recur-event-stream event rule-obj)
-  (stream-unfold
-
-   ;; Event x Rule → Event
-   (match-lambda
-     ((last r)
-      (let ((e (copy-vcomponent last)))   ; new event
-        (cond
-
-         ((memv (freq r) '(SECONDLY MINUTELY HOURLY DAILY WEEKLY))
-          (mod! (attr e 'DTSTART)       ; MUTATE
-                (cut add-duration! <>
-                     (make-duration
-                      (* (interval r)   ; INTERVAL
-                         (seconds-in (freq r)))))))
-
-         ((memv (freq r) '(MONTHLY YEARLY))
-          #f ; Hur fasen beräkrnar man det här!!!!
-          ))
-
-        ;; TODO this is just here for testing
-        (mod! (attr e 'NEW_ATTR) not)   ; MUTATE
-        ;; This segfaults...
-        ;; (set! (attr e 'N) #t)           ; MUTATE
-        ((@ (vcalendar output) print-vcomponent) e)
-        (set! (attr e 'D) #t)
-
-        (set! (attr e 'DTEND)           ; MUTATE
-              (add-duration
-               (attr e 'DTSTART)
-               (attr e 'DURATION)))
-        e)))
-
-   ;; Event x Rule → Bool (continue?)
-   (match-lambda
-     ((e r)
-
-      (or (and (not (until r)) (not (count r)))                   ; Never ending
-          (and=> (count r) (negate zero?))                        ; COUNT
-          (and=> (until r) (cut time<=? (attr e 'DTSTART) <>))))) ; UNTIL
-
-   ;; _ x Rule → (_, (next) Rule)
-   (match-lambda
-     ((e r)
-      (list
-       e (if (count r)
-             ;; Note that this doesn't modify, since r is immutable.
-             (mod! (count r) 1-)
-             r))))
-
-   ;; Seed
-   (list event rule-obj)))
-
-
-(define (generate-recurrence-set event)
-  (unless (attr event "DURATION")
-    (set! (attr event "DURATION")       ; MUTATE
-          (time-difference
-           (attr event "DTEND")
-           (attr event "DTSTART"))))
-  (recur-event-stream event (parse-recurrence-rule (attr event "RRULE"))))
-
-  ;; How doee stream-unfold even work?
-  ;; What element is used as the next seed?
-;;; stream-fold:
-;; (stream-let recur ((base base))
-;;     (if (pred? base)
-;;         (stream-cons (mapper base) (recur (generator base)))
-;;         stream-null))
diff --git a/vcalendar/recurrence/internal.scm b/vcalendar/recurrence/internal.scm
deleted file mode 100644
index b62d75c2..00000000
--- a/vcalendar/recurrence/internal.scm
+++ /dev/null
@@ -1,28 +0,0 @@
-(define-module (vcalendar recurrence internal)
-  #:use-module (util)
-  #:use-module (srfi srfi-88)
-  #:export (make-recur-rule
-            weekdays intervals))
-
-;; (list
-;;  (build-recur-rules "FREQ=HOURLY")
-;;  (build-recur-rules "FREQ=HOURLY;COUNT=3")
-;;  (build-recur-rules "FREQ=ERR;COUNT=3")
-;;  (build-recur-rules "FREQ=HOURLY;COUNT=err")
-;;  (build-recur-rules "FREQ=HOURLY;COUNT=-1"))
-
-;; Immutable, since I easily want to be able to generate the recurence set for
-;; the same event multiple times.
-(define-quick-record recur-rule
-  (public: freq until count interval bysecond byminute byhour
-           byday bymonthday byyearday byweekno bymonth bysetpos
-           wkst))
-
-(define (make-recur-rule interval wkst)
-  ((record-constructor <recur-rule> '(interval wkst)) interval wkst))
-
-(define weekdays
-  '(SU MO TU WE TH FR SA))
-
-(define intervals
-  '(SECONDLY MINUTELY HOURLY DAILY WEEKLY MONTHLY YEARLY))
diff --git a/vcalendar/recurrence/parse.scm b/vcalendar/recurrence/parse.scm
deleted file mode 100644
index abead3a9..00000000
--- a/vcalendar/recurrence/parse.scm
+++ /dev/null
@@ -1,106 +0,0 @@
-(define-module (vcalendar recurrence parse)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-19)           ; Datetime
-  #:use-module (srfi srfi-19 util)
-  #:use-module (srfi srfi-26)
-  #:use-module ((vcalendar datetime) #:select (parse-datetime))
-  #:duplicates (last)                   ; Replace @var{count}
-  #:use-module (vcalendar recurrence internal)
-  #:use-module (util)
-  #:use-module (exceptions)
-  #:use-module (ice-9 curried-definitions)
-  #:export (parse-recurrence-rule))
-
-(define (parse-recurrence-rule str)
-  "Takes a RECUR value (string), and returuns a <recur-rule> object"
- (catch #t
-  (lambda () (%build-recur-rules str))
-  (lambda (err cont obj key val . rest)
-    (let ((fmt (case err
-                 ((unfulfilled-constraint)
-                  "ERR ~a [~a] doesn't fulfill constraint of type [~a], ignoring~%")
-                 ((invalid-value)
-                  "ERR ~a [~a] for key [~a], ignoring.~%")
-                 (else "~a ~a ~a"))))
-      (format #t fmt err val key))
-    (cont obj))))
-
-(eval-when (expand)
- (define ((handle-case stx obj) key val proc)
-   (with-syntax ((skey (datum->syntax
-                        stx (symbol-downcase (syntax->datum key)))))
-     #`((#,key)
-        (let ((v #,val))
-          (cond ((not v) (throw-returnable 'invalid-value #,obj (quote #,key) v))
-                ((#,proc #,val) (set! (skey #,obj) v))
-                (else (set! (skey #,obj)
-                            (throw-returnable 'unfulfilled-constraint
-                                              #,obj (quote #,key) v)))))))))
-
-
-;; A special form of case only useful in parse-recurrence-rules above.
-;; Each case is on the form (KEY val check-proc) where:
-;; `key` is what should be matched against, and what is used for the setter
-;; `val` is the value to bind to the loop object and
-;; `check` is something the object must conform to
-(define-syntax quick-case
-  (lambda (stx)
-   (syntax-case stx ()
-     ((_ var-key obj (key val proc) ...)
-      #`(case var-key
-          #,@(map (handle-case stx #'obj)
-                  #'(key ...)
-                  #'(val ...)
-                  #'(proc ...))
-        (else obj))))))
-
-(define-syntax all-in
-  (syntax-rules ()
-    ((_ var rules ...)
-     (cut every (lambda (var) (and rules ...)) <>))))
-
-(define (string->number-list val delim)
-  (map string->number (string-split val delim)))
-
-(define (string->symbols val delim)
-  (map string->symbol (string-split val delim)))
-
-(define (%build-recur-rules str)
-  (fold
-   (lambda (kv obj)
-     (let* (((key val) kv)
-            ;; Lazy fields for the poor man.
-            (symb (lambda () (string->symbol val)))
-            (date (lambda () (parse-datetime val)))
-            (num  (lambda () (string->number val)))
-            (nums (lambda () (string->number-list val #\,))))
-       (quick-case (string->symbol key) obj
-                   (FREQ     (symb) (cut memv <> intervals)) ; Requirek
-                   (UNTIL    (date) identity)
-                   (COUNT    (num)  (cut <= 0 <>))
-                   (INTERVAL (num)  (cut <= 0 <>))
-                   (BYSECOND (nums) (all-in n (<= 0 n 60)))
-                   (BYMINUTE (nums) (all-in n (<= 0 n 59)))
-                   (BYHOUR   (nums) (all-in n (<= 0 n 23)))
-
-                   ;; TODO
-                   ;; <weekday> ∈ weekdays
-                   ;; <weekdaynum> ::= [[±] <num>] <weekday> ;; +3MO
-                   ;; (<weekadynum>, ...)
-                   ;; (BYDAY (string-split val #\,))
-
-                   (BYMONTHDAY (nums) (all-in n (<=  -31 n  31) (!= n 0)))
-                   (BYYEARDAY  (nums) (all-in n (<= -366 n 366) (!= n 0)))
-                   (BYWEEKNO   (nums) (all-in n (<=  -53 n  53) (!= n 0)))
-                   (BYMONTH    (nums) (all-in n (<=    1 n  12)))
-                   (BYSETPOS   (nums) (all-in n (<= -366 n 366) (!= n 0)))
-
-                   (WKST (symb) (cut memv <> weekdays))
-                   )))
-
-   ;; obj
-   (make-recur-rule 1 'MO)
-
-   ;; ((key val) ...)
-   (map (cut string-split <> #\=)
-        (string-split str #\;))))