aboutsummaryrefslogtreecommitdiff
path: root/main.scm
blob: 87be8bdf1c2f6afd63a3d5b971f20d2b59735410 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
#!/usr/bin/guile \
-e main -s
!#

(add-to-load-path ".")

(use-modules (srfi srfi-1)
             (srfi srfi-19)
             (srfi srfi-26)
             (vcalendar)
             (code))

;;; ------------------------------------------------------------

(define (parse-dates! cal)
;;; Parse all start times into scheme date objects.
  (for-each-in (children cal 'VEVENT)
               (cut transform-attr! <> "DTSTART"
                    (lambda (start)
                      (localize-date
                        (string->date
                          start
                          (case (string-length start)
                            ((8) "~Y~m~d")
                            ((15) "~Y~m~dT~H~M~S")
                            ((16) "~Y~m~dT~H~M~S~z"))))))))

(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)))))


(define (main args)
  (define path
    (if (null? (cdr (command-line)))
        "testcal/d1-b.ics"
        (cadr (command-line))))

  (define cal (make-vcomponent path))

  (parse-dates! cal)

  ;; Sort the events, and print a simple agenda.

  (for-each-in (sort* (children cal 'VEVENT)
                      time<? (compose date->time-utc (extract "DTSTART")))
               (lambda (ev) (format #t "~a | ~a~%"
                               (let ((start (get-attr ev "DTSTART")))
                                 (color-if (date-today? start) STR-YELLOW
                                           (date->string start "~1 ~H:~M")))
                               (get-attr ev "SUMMARY")))))


  #; (define pizza-event (search cal "pizza"))