aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-05-01 13:10:19 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-05-01 13:10:19 +0200
commitb0f51a25df76316c1cd6aa8ea97d3eb213c72cb3 (patch)
treef3efafe4bb0a80075d4bc2915a6d25586b6a28ea
parentNote in README about TippedJS. (diff)
parentMerge branch 'app'. (diff)
downloadcalp-b0f51a25df76316c1cd6aa8ea97d3eb213c72cb3.tar.gz
calp-b0f51a25df76316c1cd6aa8ea97d3eb213c72cb3.tar.xz
Merge branch 'master' into tooltip
-rw-r--r--README2
-rw-r--r--README.in2
-rwxr-xr-xmain6
-rw-r--r--module/datetime/app.scm18
-rw-r--r--module/datetime/zic.scm5
-rw-r--r--module/entry-points/html.scm17
-rw-r--r--module/entry-points/ical.scm9
-rw-r--r--module/entry-points/server.scm67
-rw-r--r--module/global.scm10
-rwxr-xr-xmodule/main.scm17
-rw-r--r--module/output/html.scm14
-rw-r--r--module/output/ical.scm19
-rw-r--r--module/repl.scm2
-rw-r--r--module/server/macro.scm17
-rw-r--r--module/util/app.scm50
-rw-r--r--module/vcomponent.scm61
-rw-r--r--module/vcomponent/load.scm55
-rw-r--r--static/script.js13
-rwxr-xr-xtzget28
19 files changed, 271 insertions, 141 deletions
diff --git a/README b/README
index 11eff8b5..f4b56e57 100644
--- a/README
+++ b/README
@@ -14,7 +14,7 @@ For basic usage, create a file ~/.config/calp/config.scm which (at
leasts) calls the f`calendar-files' with a list of files or
directories containing ics file. (Both single calendar files, and
vdir's are supported, see vdirsyncer and ikhal). Then run:
- module/main.scm html --chunked --count 1
+ ./main html --chunked --count 1
Which should generate a single HTML-page for the current month.
Contributing
diff --git a/README.in b/README.in
index a750e0f4..b3726eee 100644
--- a/README.in
+++ b/README.in
@@ -5,7 +5,7 @@
Calp is primarily a program for loading calendar files (.ics's) from drendering them in different formats. The goal is however to also support fancy filtering, an edit server, and more. The currently working frontends is the HTML-frontend, which have the two main modes of a month-by-month in "week" view, or a table of a single month, and the terminal frontend. The terminatend is mostly for debugging purposes, but it's quite usable still.
For basic usage, create a file ~/.config/calp/config.scm which (at leasts) calls the f`calendar-files' with a list of files or directories containing ics file. (Both single calendar files, and vdir's are supported, see vdirsyncer and ikhal). Then run:
- module/main.scm html --chunked --count 1
+ ./main html --chunked --count 1
Which should generate a single HTML-page for the current month.
Contributing
diff --git a/main b/main
new file mode 100755
index 00000000..2d3e7e4a
--- /dev/null
+++ b/main
@@ -0,0 +1,6 @@
+#!/bin/bash
+
+here=$(dirname $(realpath $0))
+. $here/env
+
+exec guile -e main -s $here/module/main.scm "$@"
diff --git a/module/datetime/app.scm b/module/datetime/app.scm
new file mode 100644
index 00000000..9797ee39
--- /dev/null
+++ b/module/datetime/app.scm
@@ -0,0 +1,18 @@
+(define-module (datetime app)
+ :use-module (util)
+ :use-module (util app)
+ :use-module (ice-9 rdelim)
+ :use-module (datetime zic))
+
+(define-method (init-app)
+ (setf 'zoneinfo
+ (let* ((pipe
+ (-> (@ (global) basedir)
+ dirname
+ (string-append "/tzget")
+ ((@ (ice-9 popen) open-input-pipe))))
+ (path (read-line pipe))
+ (names (string-split (read-line pipe) #\space)))
+ (read-zoneinfo
+ (map (lambda (s) (string-append path file-name-separator-string s))
+ names)))))
diff --git a/module/datetime/zic.scm b/module/datetime/zic.scm
index 52457ada..02f3230f 100644
--- a/module/datetime/zic.scm
+++ b/module/datetime/zic.scm
@@ -19,7 +19,7 @@
:use-module (srfi srfi-9 gnu))
-(define-public (read-zoneinfo . ports-or-filenames)
+(define-public (read-zoneinfo ports-or-filenames)
(parsed-zic->zoneinfo
(concatenate
(map (lambda (port-or-filename)
@@ -377,7 +377,8 @@
;; group rules and put in map
(awhen (assoc-ref groups 'rule)
(for-each (lambda (group)
- (hashq-set! rules (car group) (sort* (cadr group) < rule-from)))
+ (hashq-set! rules (car group) (sort* (cadr group) (lambda (a b) (if (eq? 'minimum) #t (< a b)))
+ rule-from)))
(group-by rule-name (car it))))
;; put zones in map
diff --git a/module/entry-points/html.scm b/module/entry-points/html.scm
index 70fbde42..d80de3b5 100644
--- a/module/entry-points/html.scm
+++ b/module/entry-points/html.scm
@@ -4,7 +4,7 @@
:use-module (util)
:use-module (util time)
:use-module (util config)
- :use-module (vcomponent)
+ ;; :use-module (vcomponent)
:use-module (datetime)
:use-module (datetime util)
:use-module (ice-9 getopt-long)
@@ -30,26 +30,17 @@
(define style (string->symbol (option-ref opts 'style "wide")))
- (define-values (calendars events)
- (cond [(option-ref opts 'file #f) => (compose load-calendars list)]
- [else (load-calendars)]))
-
-
- (report-time! "Calendars loaded")
-
(case style
- [(unchunked)
- (html-generate calendars events start end render-calendar)]
[(wide) ; previously `chunked'
- (html-chunked-main count calendars events start (date month: 1))]
+ (html-chunked-main count start (date month: 1))]
[(week)
;; TODO The small calendar is always centered on months, it might
;; be a good idea to instead center it on the current week, meaning
;; that the active row is always in the center
- (html-chunked-main count calendars events
+ (html-chunked-main count
(start-of-week start (get-config 'week-start))
(date day: 7))]
[(table)
- (html-table-main count calendars events start)]
+ (html-table-main count start)]
[else
(error "Unknown html style: ~a" style)]))
diff --git a/module/entry-points/ical.scm b/module/entry-points/ical.scm
index f2f4e0b5..dc060ec6 100644
--- a/module/entry-points/ical.scm
+++ b/module/entry-points/ical.scm
@@ -22,11 +22,4 @@
;; [else (normalize-date* (set (month start) = (+ 1)))]
[(date+ start (date month: 1))]
))
-
- ;; TODO this contains repeated events multiple times
- (define-values (calendars regular repeating)
- (cond [(option-ref opts 'file #f) => (compose load-calendars* list)]
- [else (load-calendars*)]))
-
- (ical-main calendars regular repeating start end)
- )
+ (ical-main start end))
diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm
index 408b00b3..63fb83a8 100644
--- a/module/entry-points/server.scm
+++ b/module/entry-points/server.scm
@@ -1,5 +1,6 @@
(define-module (entry-points server)
:use-module (util)
+ :use-module (util app)
:use-module (srfi srfi-1)
@@ -38,23 +39,25 @@
(with-output-to-string
(lambda () (display "<!doctype html>\n") (sxml->xml sxml))))
+(define (// . args) (string-join args file-name-separator-string ))
+
(define (directory-table dir)
`(table
(thead
(tr (th "") (th "Name") (th "Perm")))
(tbody
,@(map (lambda (k)
- (let* ((stat (lstat k)))
+ (let* ((stat (lstat (// dir k))))
`(tr (td ,(case (stat:type stat)
[(directory) "📁"]
[(regular) "📰"]
[else "🙃"]))
- (td (a (@ (href "/" ,dir ,k)) ,k))
+ (td (a (@ (href "/" ,dir "/" ,k)) ,k))
(td ,(number->string (stat:perms stat) 8)))))
- (cddr (scandir dir))))))
+ (cdr (scandir dir))))))
-(define (make-make-routes calendar regular repeating events)
+(define-method (make-make-routes)
(make-routes
(GET "/week/:start-date.html" (start-date)
@@ -63,8 +66,8 @@
(return '((content-type text/html))
(with-output-to-string
(lambda ()
- (html-generate calendars: calendar
- events: events
+ (html-generate calendars: (getf 'calendars)
+ events: (getf 'event-set)
start-date: start-date
end-date: (date+ start-date (date day: 6))
next-start: (lambda (d) (date+ d (date day: 7)))
@@ -78,8 +81,8 @@
(return '((content-type text/html))
(with-output-to-string
(lambda ()
- (html-generate calendars: calendar
- events: events
+ (html-generate calendars: (getf 'calendars)
+ events: (getf 'event-set)
start-date: start-date
end-date: (date- (month+ start-date)
(date day: 1))
@@ -95,19 +98,12 @@
(return '((content-type text/calendar))
(with-output-to-string
(lambda ()
- (ical-main calendar
- regular
- repeating
- (parse-iso-date start)
+ (ical-main (parse-iso-date start)
(parse-iso-date end))))))
- ;; TODO this returns "invalid" events, since the surrounding VCALENDAR is missing.
+ ;; TODO this fails if there's a period in the uid.
(GET "/calendar/:uid.ics" (uid)
- ;; NOTE build an index.
- (aif (or (find (lambda (ev) (equal? uid (attr ev 'UID)))
- regular)
- (find (lambda (ev) (equal? uid (attr ev 'UID)))
- repeating))
+ (aif (get-event-by-uid uid)
(return '((content-type text/calendar))
(with-output-to-string
(lambda () (print-components-with-fake-parent
@@ -115,23 +111,23 @@
(return (build-response code: 404)
(format #f "No component with UID=~a found." uid))))
- (GET "/static" ()
- (return
- '((content-type text/html))
- (sxml->html-string
- (directory-table "static/"))))
+ ;; NOTE this only handles files with extensions. Limited, but since this
+ ;; is mostly for development, and something like nginx should be used in
+ ;; production it isn't a huge problem.
- (GET "/static/:filename.css" (filename)
+ (GET "/static/:*{.*}.:ext" (* ext)
(return
- `((content-type text/css))
- (call-with-input-file (string-append "static/" filename ".css")
+ ;; TODO actually check mimetype
+ `((content-type ,(string->symbol (string-append "text/" ext))))
+ (call-with-input-file (string-append "static/" * "." ext)
read-string)))
- (GET "/static/:filename.js" (filename)
+ (GET "/static/:*{.*}" (*)
(return
- `((content-type text/javascript))
- (call-with-input-file (string-append "static/" filename ".js")
- read-string)))
+ '((content-type text/html))
+ (sxml->html-string
+ (directory-table (// "static" *)))))
+
(GET "/count" ()
;; (sleep 1)
@@ -160,15 +156,6 @@
[(and addr (string-contains addr ".")) AF_INET]
[else AF_INET6]))
- (define-values (c regular repeating)
- (cond [(option-ref opts 'file #f) => (compose load-calendars* list)]
- [else (load-calendars*)]))
-
- (define all-events
- ((@ (vcomponent load) calculate-recurrence-set) regular repeating))
-
-
-
;; update address if it was left blank. A bit clumsy since
;; @var{addr} & @var{family} depend on each other.
;; placed after load-calendars to keep Guile 2.2 compability.
@@ -195,7 +182,7 @@
addr port
(getpid) (getcwd))
- (run-server (make-make-routes c regular repeating all-events)
+ (run-server (make-make-routes)
'http
`(family: ,family
port: ,port
diff --git a/module/global.scm b/module/global.scm
new file mode 100644
index 00000000..f8d0cd7f
--- /dev/null
+++ b/module/global.scm
@@ -0,0 +1,10 @@
+(define-module (global))
+
+;; TODO encapsulating these in
+;; atomic boxes might be a good
+;; idea.
+
+(define-once basedir #f)
+
+(export basedir)
+
diff --git a/module/main.scm b/module/main.scm
index 246e729c..332d9990 100755
--- a/module/main.scm
+++ b/module/main.scm
@@ -1,10 +1,9 @@
-#!/bin/bash
-# -*- mode: scheme; geiser-scheme-implementation: guile -*-
+;; -*- geiser-scheme-implementation: guile -*-
-. $(dirname $(dirname $(realpath $0)))/env
+(when (current-filename)
+ (add-to-load-path (dirname (current-filename))))
-exec guile -e main -s $0 "$@"
-!#
+(set! (@ (global) basedir) (car %load-path))
(use-modules (srfi srfi-1)
(srfi srfi-41)
@@ -14,6 +13,7 @@ exec guile -e main -s $0 "$@"
(util)
(util io)
(util time)
+ (util app)
((entry-points html) :prefix html-)
((entry-points terminal) :prefix terminal-)
@@ -32,6 +32,7 @@ exec guile -e main -s $0 "$@"
)
+
(define options
'((statprof (value optional))
(repl (value optional))
@@ -57,6 +58,12 @@ exec guile -e main -s $0 "$@"
(when (file-exists? config-file)
(primitive-load config-file)))
+
+ ;; (current-app (make-app))
+
+ ((@ (vcomponent) init-app) (get-config 'calendar-files))
+ ((@ (datetime app) init-app))
+
(let ((ropt (ornull (option-ref opts '() '())
'("term"))))
((case (string->symbol (car ropt))
diff --git a/module/output/html.scm b/module/output/html.scm
index 79a44a41..fb771507 100644
--- a/module/output/html.scm
+++ b/module/output/html.scm
@@ -7,6 +7,7 @@
#:use-module (vcomponent group)
#:use-module (vcomponent datetime)
#:use-module (util)
+ #:use-module (util app)
#:use-module (util exceptions)
#:use-module (util config)
#:use-module (util tree)
@@ -753,7 +754,11 @@
,@(stream->list (stream-map fmt-day evs))))))))
-(define-public (html-chunked-main count calendars events start-date chunk-length)
+(define-method (html-chunked-main count start-date chunk-length)
+
+ (define calendars (getf 'calendars))
+ (define events (getf 'event-set))
+
;; TODO This still doesn't account for PWD, file existing but is of
;; wrong type, html directory existing but static symlink missing,
;; static being a different file type, and probably something else
@@ -786,7 +791,12 @@
(cdr ms))))))))
-(define-public (html-table-main count calendars events start-date)
+
+(define-method (html-table-main count start-date)
+
+ (define calendars (getf 'calendars))
+ (define events (getf 'event-set))
+
;; TODO same file creation as in html-chunked-main
(stream-for-each
(lambda (start-of-month)
diff --git a/module/output/ical.scm b/module/output/ical.scm
index 822d929d..098d4e90 100644
--- a/module/output/ical.scm
+++ b/module/output/ical.scm
@@ -2,6 +2,7 @@
:use-module (ice-9 format)
:use-module (ice-9 match)
:use-module (util)
+ :use-module (util app)
:use-module (vcomponent)
:use-module (vcomponent datetime)
:use-module (srfi srfi-1)
@@ -139,10 +140,6 @@
;; TODO place these somewhere better
(define *prodid* "-//hugo//Calparse 0.9//EN")
-(define *zoneinfo* (apply read-zoneinfo
- ;; TODO move this to config, and figure out
- ;; how to best acquire/bundle zoneinfo.
- (glob "~/down/tz/{africa,antartica,asia,australasia,europe,northamerica,southamerica,backward}")))
;; TODO tzid prop on dtstart vs tz field in datetime object
;; how do we keep these two in sync?
@@ -156,7 +153,7 @@
(add-child! cal event)
(awhen (prop (attr* event 'DTSTART) 'TZID)
- (add-child! cal (zoneinfo->vtimezone *zoneinfo* it)))
+ (add-child! cal (zoneinfo->vtimezone (getf 'zoneinfo) it)))
(unless (attr event 'UID)
(set! (attr event 'UID)
@@ -205,7 +202,7 @@ CALSCALE:GREGORIAN\r
(let ((tz-names (get-tz-names events)))
(for-each component->ical-string
;; TODO we realy should send the earliest event from each timezone here.
- (map (lambda (name) (zoneinfo->vtimezone *zoneinfo* name (car events)))
+ (map (lambda (name) (zoneinfo->vtimezone (getf 'zoneinfo) name (car events)))
tz-names)))
(for-each component->ical-string events)
@@ -214,15 +211,11 @@ CALSCALE:GREGORIAN\r
;; TODO add support for running without a range limiter, emiting all objects.
-;; list x list x list x time x time →
-(define-public (ical-main calendars regular-events repeating-events start end)
-
+(define-public (ical-main start end)
(print-components-with-fake-parent
- (append (filter-sorted (lambda (ev) ((in-date-range? start end)
- (as-date (attr ev 'DTSTART))))
- regular-events)
+ (append (fixed-events-in-range start end)
;; TODO RECCURENCE-ID exceptions
;; We just dump all repeating objects, since it's much cheaper to do
;; it this way than to actually figure out which are applicable for
;; the given date range.
- repeating-events)))
+ (getf 'repeating-events))))
diff --git a/module/repl.scm b/module/repl.scm
index f73f3da6..a0133403 100644
--- a/module/repl.scm
+++ b/module/repl.scm
@@ -1,6 +1,6 @@
(define-module (repl)
:use-module (system repl server)
- )
+ :use-module (ice-9 regex))
(define-public (runtime-dir)
(or (getenv "XDG_RUNTIME_DIR")
diff --git a/module/server/macro.scm b/module/server/macro.scm
index b9ce94bb..28565c3b 100644
--- a/module/server/macro.scm
+++ b/module/server/macro.scm
@@ -9,15 +9,28 @@
(define-public (parse-endpoint-string str)
- (let ((rx (make-regexp ":([^/.]+)")))
+ (let ((rx (make-regexp ":([^/.]+)(\\{([^}]+)\\})?([.])?")))
(let loop ((str str)
(string "")
(tokens '()))
(let ((m (regexp-exec rx str 0)))
(if (not m)
+ ;; done
(values (string-append string str) (reverse tokens))
+
(loop (match:suffix m)
- (string-append string (match:prefix m) "([^/.]+)")
+ (string-append string (match:prefix m)
+ (aif (match:substring m 3)
+ (string-append "(" it ")")
+ "([^/.]+)")
+ ;; period directly following matched variable.
+ ;; since many variables break on period, we often
+ ;; want to match a literal period directly after them.
+ ;; Ideally all periods outside of pattern should be
+ ;; matched literally, but that's harder to implement.
+ (regexp-quote
+ (aif (match:substring m 4)
+ "." "")))
(cons (string->symbol (match:substring m 1))
tokens)))))))
diff --git a/module/util/app.scm b/module/util/app.scm
new file mode 100644
index 00000000..e5b03b0f
--- /dev/null
+++ b/module/util/app.scm
@@ -0,0 +1,50 @@
+(define-module (util app)
+ :use-module (util)
+ :use-module (srfi srfi-1)
+ :use-module (srfi srfi-9)
+ :use-module (srfi srfi-9 gnu)
+ :export (make-app current-app define-method getf setf)
+ )
+
+(define-immutable-record-type <app>
+ (make-app% ht) app? (ht get-ht))
+
+(define-public (make-app)
+ (make-app% (make-hash-table)))
+
+(define current-app (make-parameter (make-app)))
+
+(define-syntax (define-method stx)
+ (with-syntax ((app (datum->syntax stx 'app)))
+ (syntax-case stx ()
+ [(_ (name args ...) body ...)
+
+ (let* ((pre post (break (lambda (s) (eqv? key: (syntax->datum s)))
+ #'(args ...))))
+ #`(define*-public (name #,@pre #,@(if (null? post) '(key:) post)
+ (app (current-app)))
+ body ...))])))
+
+
+(define-method (getf field)
+ (aif (hashq-ref (get-ht app) field)
+ (force it)
+ (error "No field" field)))
+
+(define-syntax setf%
+ (syntax-rules ()
+ [(_ field value)
+ (setf% (current-app) field value)]
+ [(_ app field value)
+ (hashq-set! (get-ht app) field (delay value))]))
+
+(define-syntax setf
+ (syntax-rules ()
+ ;; special case to use current appp)
+ [(_ key value)
+ (setf% key value)]
+
+ [(_ app) app]
+ [(_ app key value rest ...)
+ (begin (setf% app key value)
+ (setf app rest ...))]))
diff --git a/module/vcomponent.scm b/module/vcomponent.scm
index 32406f0a..aaaf5d36 100644
--- a/module/vcomponent.scm
+++ b/module/vcomponent.scm
@@ -1,10 +1,69 @@
(define-module (vcomponent)
+ :use-module (util)
+ :use-module (util app)
+ :use-module (srfi srfi-1)
+ :use-module (srfi srfi-41)
+ :use-module (srfi srfi-41 util)
+ :use-module (datetime)
+ :use-module (datetime util)
:use-module (vcomponent base)
:use-module (vcomponent parse)
:use-module (vcomponent load)
- :use-module (util)
+ :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?))
+ :use-module ((vcomponent datetime) :select (ev-time<?))
:re-export (make-vcomponent
parse-cal-path parse-calendar
load-calendars load-calendars*))
(re-export-modules (vcomponent base))
+
+
+;; TODO rename function
+(define (calculate-recurrence-set regular repeating)
+ (interleave-streams
+ ev-time<?
+ (cons (list->stream regular)
+ (map (@ (vcomponent recurrence) generate-recurrence-set) repeating)
+ )))
+
+
+(define-method (init-app calendar-files)
+ (setf 'calendars (load-calendars calendar-files))
+
+ (setf 'events
+ (concatenate
+ ;; TODO does this drop events?
+ (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o)))
+ (children cal)))
+ (getf 'calendars))))
+
+ (setf 'fixed-and-repeating-events
+ (let* ((repeating regular (partition repeating? (getf 'events))))
+
+ ;; (report-time! "Sorting")
+ ;; NOTE There might be instances where we don't care if the
+ ;; collection if sorted, but for the time beieng it's much
+ ;; easier to always sort it.
+ (list
+ (sort*! regular date/-time<? (extract 'DTSTART))
+ (sort*! repeating date/-time<? (extract 'DTSTART)))))
+
+ (setf 'fixed-events (car (getf 'fixed-and-repeating-events)))
+ (setf 'repeating-events (cadr (getf 'fixed-and-repeating-events)))
+
+ (setf 'event-set (calculate-recurrence-set
+ (getf 'fixed-events)
+ (getf 'repeating-events)))
+
+ (setf 'uid-map
+ (let ((ht (make-hash-table)))
+ (for-each (lambda (event) (hash-set! ht (attr event 'UID) event)) (getf 'events))
+ ht)))
+
+(define-method (fixed-events-in-range start end)
+ (filter-sorted (lambda (ev) ((in-date-range? start end)
+ (as-date (attr ev 'DTSTART))))
+ (getf 'fixed-events)))
+
+(define-method (get-event-by-uid uid)
+ (hash-ref (getf 'uid-map) uid))
diff --git a/module/vcomponent/load.scm b/module/vcomponent/load.scm
index 37d57b56..09dcd3c8 100644
--- a/module/vcomponent/load.scm
+++ b/module/vcomponent/load.scm
@@ -1,59 +1,10 @@
(define-module (vcomponent load)
:export (load-calendars load-calendars*)
:use-module (util)
- :use-module (util time)
:use-module (util config)
- :use-module (srfi srfi-1)
- :use-module (datetime)
- :use-module (datetime util)
- :use-module (srfi srfi-41)
- :use-module (srfi srfi-41 util)
- ;; :use-module (parameters)
- ;; :use-module (vcomponent)
- :use-module (vcomponent base)
- :use-module ((vcomponent parse) :select (parse-cal-path))
- :use-module ((vcomponent recurrence) :select (generate-recurrence-set repeating?))
- :use-module ((vcomponent datetime) :select (ev-time<?)))
+ :use-module ((vcomponent parse) :select (parse-cal-path)))
(define-config calendar-files '() "" list?)
-(define-public (calculate-recurrence-set regular repeating)
- (interleave-streams
- ev-time<?
- (cons (list->stream regular)
- (map generate-recurrence-set repeating)
- )))
-
-;; Reads all calendar files from disk, generate recurence-sets for all repeating events,
-;; and returns a list of calendars, and a stream of all events "ready" for display.
-(define* (load-calendars #:optional (calendar-files (get-config 'calendar-files)))
- (report-time! "Parsing ~a calendars" (length calendar-files))
- (let* ((calendars regular repeating (load-calendars* calendar-files)))
- (report-time! "Calendars loaded, interleaving and reccurring")
- (values
- calendars
- (calculate-recurrence-set regular repeating))))
-
-;; Basic version, loads calendrs, sorts the events, and returns
-;; regular and repeating events separated from each other.
-;;
-;; (list string) → (list calendar), (list event), (list event)
-(define* (load-calendars* #:optional (calendar-files (get-config 'calendar-files)))
-
- (define calendars (map parse-cal-path calendar-files))
- (define events (concatenate
- ;; TODO does this drop events?
- (map (lambda (cal) (filter (lambda (o) (eq? 'VEVENT (type o)))
- (children cal)))
- calendars)))
-
- (report-time! "Parse done, partitioning...")
- (let* ((repeating regular (partition repeating? events)))
-
- (report-time! "Sorting")
- ;; NOTE There might be instances where we don't care if the
- ;; collection if sorted, but for the time beieng it's much
- ;; easier to always sort it.
- (values calendars
- (sort*! regular date/-time<? (extract 'DTSTART))
- (sort*! repeating date/-time<? (extract 'DTSTART)))))
+(define* (load-calendars calendar-files)
+ (map parse-cal-path calendar-files))
diff --git a/static/script.js b/static/script.js
index 4fbf160e..6cca186e 100644
--- a/static/script.js
+++ b/static/script.js
@@ -222,6 +222,12 @@ function setVar(str, val) {
document.documentElement.style.setProperty("--" + str, val);
}
+function close_all_popups () {
+ for (let popup of document.getElementsByClassName("popup")) {
+ popup.classList.remove("show");
+ }
+}
+
window.onload = function () {
start_time.setTime(document.querySelector("meta[name='start-time']").content * 1000)
end_time.setTime(document.querySelector("meta[name='end-time']").content * 1000)
@@ -258,6 +264,13 @@ window.onload = function () {
*/
+ document.onkeydown = function (evt) {
+ evt = evt || window.event;
+ if (evt.key.startsWith("Esc")) {
+ close_all_popups();
+ }
+ }
+
}
$(document).ready(function() {
diff --git a/tzget b/tzget
new file mode 100755
index 00000000..1fd2340a
--- /dev/null
+++ b/tzget
@@ -0,0 +1,28 @@
+#!/bin/bash
+
+CACHE_DIR=${CACHE_DIR:-~/.cache/calp}
+RELEASE=2020a
+TZ_SRC="https://github.com/eggert/tz/archive/$RELEASE.tar.gz"
+
+mkdir -p $CACHE_DIR
+cd $CACHE_DIR
+
+test -f "$RELEASE.tar.gz" || curl -sOL $TZ_SRC
+test -d "tz-$RELEASE" || tar xzf "$RELEASE.tar.gz"
+cd "tz-$RELEASE"
+
+tzpath=$(pwd)
+
+size=$(stat -c "%s" Makefile)
+
+cat >> Makefile << EOF
+.PHONY: print-tdata
+print-tdata:
+ @echo \$(TDATA_TO_CHECK)
+EOF
+files=$(make print-tdata)
+
+truncate -cs $size Makefile
+
+echo $tzpath
+echo $files