diff options
| -rwxr-xr-x | main.scm | 36 | ||||
| -rw-r--r-- | srfi/srfi-19/util.scm | 4 | ||||
| -rwxr-xr-x | test.scm | 1 | ||||
| -rw-r--r-- | vcalendar.scm | 22 | ||||
| -rw-r--r-- | vcalendar/output.scm (renamed from code.scm) | 32 | ||||
| -rw-r--r-- | vcalendar/recur.scm | 2 |
6 files changed, 38 insertions, 59 deletions
@@ -4,43 +4,33 @@ (add-to-load-path (dirname (current-filename))) -(use-modules (srfi srfi-1) - (srfi srfi-19) +(use-modules (srfi srfi-19) (srfi srfi-19 util) - (srfi srfi-26) (vcalendar) - (util) - (code)) + (vcalendar output) + (util)) -;;; ------------------------------------------------------------ - - -(define (search cal term) - (cdr (let ((events (filter (lambda (ev) (eq? 'VEVENT (type ev))) - (children cal)))) - (find (lambda (ev) (string-contains-ci (car ev) term)) - (map cons (map (cut get-attr <> "SUMMARY") - events) - events))))) +;;; This function borrowed from web-ics (calendar util) +(define* (sort* items comperator #:optional (get identity)) + "A sort function more in line with how python's sorted works" + (sort items (lambda (a b) + (comperator (get a) + (get b))))) +;;; ------------------------------------------------------------ (define (main args) - (define path - (if (null? (cdr (command-line))) - "testcal/repeating-event.ics" - (cadr (command-line)))) - + (define path (cadr (append args '("testcal/repeating-event.ics")))) (define cal (make-vcomponent path)) ;; Sort the events, and print a simple agenda. - (for-each-in (sort* (children cal 'VEVENT) time<? (extract "DTSTART")) (lambda (ev) (format #t "~a | ~a~%" - (let ((start (get-attr ev "DTSTART"))) + (let ((start (attr ev "DTSTART"))) (color-if (today? start) STR-YELLOW (time->string start "~1 ~H:~M"))) - (get-attr ev "SUMMARY"))))) + (attr ev "SUMMARY"))))) #; (define pizza-event (search cal "pizza")) diff --git a/srfi/srfi-19/util.scm b/srfi/srfi-19/util.scm index 2d709d55..81dd7ec5 100644 --- a/srfi/srfi-19/util.scm +++ b/srfi/srfi-19/util.scm @@ -26,7 +26,7 @@ (define (drop-time date) "Returns a copy of date; with the hour, minute, second and nanosecond -attribute set to 0." +attribute set to 0. Can also be seen as \"Start of day\"" (set-fields date ((date-hour) 0) ((date-minute) 0) @@ -44,7 +44,7 @@ attribute set to 0." (add-duration time (make-time time-duration 0 (* amount unit)))) (define (today? time) - (let* ((now (date->time-utc (current-date))) + (let* ((now (date->time-utc (drop-time (current-date)))) (then (time-add now 1 days))) (and (time<=? now time) (time<=? time then)))) @@ -8,7 +8,6 @@ (srfi srfi-19) (srfi srfi-19 util) (srfi srfi-41) - (code) (vcalendar) (vcalendar recur)) diff --git a/vcalendar.scm b/vcalendar.scm index 03817957..c664c1aa 100644 --- a/vcalendar.scm +++ b/vcalendar.scm @@ -6,7 +6,7 @@ #:use-module (util)) (define (parse-dates! cal) -;;; Parse all start times into scheme date objects. + "Parse all start times into scheme date objects." (for-each-in (children cal 'VEVENT) (lambda (ev) (transform-attr! ev "DTSTART" parse-datetime) @@ -45,8 +45,8 @@ childs))) (export children) -(define-public set-attr! %vcomponent-set-attribute!) -(define-public get-attr %vcomponent-get-attribute) +(define set-attr! %vcomponent-set-attribute!) +(define get-attr %vcomponent-get-attribute) ;; Enables symmetric get and set: ;; (set! (attr ev "KEY") 10) @@ -59,11 +59,6 @@ (define-public (transform-attr! ev field transformer) "Apply transformer to field in ev, and store the result back." - #; - (set-attr! ev field - (transformer - (get-attr ev field))) - ;; TODO make transform C primitive. ;; Halfing the lookups. (set! (attr ev field) @@ -72,3 +67,14 @@ ;; { (attr ev field) := (transformer (attr ev field)) } (define-public copy-vcomponent %vcomponent-shallow-copy) + +(define-public (search cal term) + (cdr (let ((events (filter (lambda (ev) (eq? 'VEVENT (type ev))) + (children cal)))) + (find (lambda (ev) (string-contains-ci (car ev) term)) + (map cons (map (cut get-attr <> "SUMMARY") + events) + events))))) + +(define-public (extract field) + (cut get-attr <> field)) diff --git a/code.scm b/vcalendar/output.scm index af6c7b8c..908dab34 100644 --- a/code.scm +++ b/vcalendar/output.scm @@ -1,28 +1,14 @@ -(define-module (code) - #:export (extract sort* color-if - STR-YELLOW STR-RESET - print-vcomponent)) - -(use-modules (srfi srfi-19) - (srfi srfi-19 util) - (srfi srfi-26) - (vcalendar) - (util)) - -(define (extract field) - (cut get-attr <> field)) - -;;; This function borrowed from web-ics (calendar util) -(define* (sort* items comperator #:optional (get identity)) - "A sort function more in line with how python's sorted works" - (sort items (lambda (a b) - (comperator (get a) - (get b))))) +(define-module (vcalendar output) + #:use-module (vcalendar) + #:use-module (util) + #:use-module (srfi srfi-26) + #:export (print-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" @@ -30,9 +16,8 @@ (begin body ...) (if pred-value STR-RESET "")))) - (define* (print-vcomponent comp #:optional (depth 0)) - (let ((kvs (map (lambda (key) (cons key (get-attr comp key))) + (let ((kvs (map (lambda (key) (cons key (attr comp key))) (attributes comp)))) (format #t "~a <~a> :: ~:a~%" (make-string depth #\:) @@ -46,4 +31,3 @@ key value)))) (for-each-in (children comp) (cut print-vcomponent <> (1+ depth))))) - diff --git a/vcalendar/recur.scm b/vcalendar/recur.scm index 23c00b12..80bd03a9 100644 --- a/vcalendar/recur.scm +++ b/vcalendar/recur.scm @@ -155,7 +155,7 @@ (time-difference (attr event "DTEND") (attr event "DTSTART")))) - (recur-event-stream event (build-recur-rules (get-attr event "RRULE")))) + (recur-event-stream event (build-recur-rules (attr event "RRULE")))) (define tzero (make-time time-utc 0 0)) (define dzero (time-utc->date tzero)) |