diff options
| -rw-r--r-- | config.scm | 1 | ||||
| -rwxr-xr-x | configure | 52 | ||||
| -rw-r--r-- | module/datetime/instance.scm | 41 | ||||
| -rw-r--r-- | module/directories.scm | 28 | ||||
| -rw-r--r-- | module/main.scm | 40 | ||||
| -rw-r--r-- | module/output/ical.scm | 20 | ||||
| -rw-r--r-- | module/server/macro.scm | 2 | ||||
| -rw-r--r-- | module/util.scm | 17 | ||||
| -rw-r--r-- | static/script.js | 2 | ||||
| -rwxr-xr-x | tzget | 12 |
10 files changed, 110 insertions, 105 deletions
@@ -77,3 +77,4 @@ (set-config! 'week-start mon) (set-config! 'default-calendar "Calendar") +(set-config! 'path-prefix (car (glob "~/.local"))) diff --git a/configure b/configure deleted file mode 100755 index a5ef456e..00000000 --- a/configure +++ /dev/null @@ -1,52 +0,0 @@ -#!/usr/bin/guile \ ---no-auto-compile -s -!# - -(define // file-name-separator-string) - -(define here (cond ((current-filename) => dirname) - (else (getcwd)))) -(define module-dir (string-append here // "module")) -(add-to-load-path module-dir) - -(use-modules (util)) - -;; --with-zoneinfo -(define zoneinfo #t) - -;; when zoneinfo -(use-modules (ice-9 rdelim)) - -(define *develop* #t) - -(define PREFIX //) -(define CACHE_DIR (string-append PREFIX // "var/cache/calp")) -(define LIBEXEC (if *develop* here (string-append PREFIX // "usr/lib/calp"))) - -(define pipe - (-> LIBEXEC - (string-append // "tzget") - ((@ (ice-9 popen) open-input-pipe)))) -(define path (read-line pipe)) -(define names (string-split (read-line pipe) #\space)) - -(use-modules (util io) - (datetime)) -(with-atomic-output-to-file - (string-append module-dir // "autoconfig.scm") - (lambda () - (display ";;; Commentary:") (newline) - (display ";;; File genererated by ./configure on ") - (display (datetime->string - (current-datetime) "~Y-~m-~d ~H:~M:~S~Z")) - (newline) - (display ";;; DONT make any manual changes") (newline) - (display ";;; Code:") (newline) - (for-each (@ (ice-9 pretty-print) pretty-print) - `((define-module (autoconfig) - use-module: (util config)) - ,@(when zoneinfo - `((set-config! 'tz-file ,path) - (set-config! 'tz-list (quote ,names)))))))) - -;; vim:ft=scheme: diff --git a/module/datetime/instance.scm b/module/datetime/instance.scm index 829002b9..db24d8a2 100644 --- a/module/datetime/instance.scm +++ b/module/datetime/instance.scm @@ -1,35 +1,32 @@ (define-module (datetime instance) :use-module (util) :use-module (util config) + :use-module (util exceptions) :use-module (datetime zic) + :use-module (directories) :export (zoneinfo)) -(define-config tz-dir #f - description: "Directory in which zoneinfo files can be found") - (define-config tz-list '() description: "List of default zoneinfo files to be parsed") - -(define / file-name-separator-string) - ;; TODO see (vcomponent instance), this has a similar problem with early load (define-once zoneinfo (let ((cache (make-hash-table))) (label self - (case-lambda - (() - (define tz-dir (get-config 'tz-dir)) - (define tz-list (get-config 'tz-list)) - (when (or (not tz-dir) (null? tz-list)) - (error "Default zoneinfo only available when tz-dir and tz-list are configured")) - (self tz-dir tz-list)) - ((directory file-list) - (let ((key (cons directory file-list))) - (aif (hash-ref cache key) - it - (let ((tz (read-zoneinfo - (map (lambda (s) (string-append directory / s)) - file-list)))) - (hash-set! cache key tz) - tz)))))))) + (case-lambda + (() + (define tz-list (get-config 'tz-list)) + (if (null? tz-list) + (warning "Default zoneinfo only available when tz-dir and tz-list are configured") + (self tz-list))) + ((file-list) + (provide 'zoneinfo) + (let* ((directory (path-append data-directory "/zoneinfo")) + (key (cons directory file-list))) + (aif (hash-ref cache key) + it + (let ((tz (read-zoneinfo + (map (lambda (s) (path-append directory s)) + file-list)))) + (hash-set! cache key tz) + tz)))))))) diff --git a/module/directories.scm b/module/directories.scm index 32cd382a..7348f6c3 100644 --- a/module/directories.scm +++ b/module/directories.scm @@ -1,5 +1,12 @@ (define-module (directories) - :use-module (util)) + :use-module (util) + :use-module (util config) + ) + +;; TODO possiblyy create a (system) parameter, which flips many +;; settings between being based in $HOME, and in / (or $prefix/). + +(define-config path-prefix "/usr") (define-public runtime-directory (or (getenv "XDG_RUNTIME_DIR") @@ -7,9 +14,26 @@ (define-public system-config-directory "/etc/calp") -(define user-config-directory +(define-public user-config-directory (path-append (or (getenv "XDG_CONFIG_HOME") (and=> (getenv "HOME") (lambda (s) (path-append s "/.config")))) "/calp")) + +(define (libexec%) + (path-append (get-config 'path-prefix) + "/lib/calp")) + +(define-syntax libexec (identifier-syntax (libexec%))) +(export libexec) + +(define (data-directory%) + (path-append + (or (getenv "XDG_DATA_HOME") + (path-append (get-config 'path-prefix) "/share")) + "/calp")) + +(define-syntax data-directory (identifier-syntax (data-directory%))) +(export data-directory) + diff --git a/module/main.scm b/module/main.scm index 361c5473..2e9a8d5e 100644 --- a/module/main.scm +++ b/module/main.scm @@ -2,26 +2,28 @@ ;; config -(catch 'misc-error - (lambda () (use-modules (autoconfig))) - (lambda (err caller fmt args . rest) - (if (eqv? (caadr args) 'autoconfig) - (format (current-error-port) "Run ./configure first~%") - (format (current-error-port) "~?~%" fmt args)) - (exit 1))) +; (catch 'misc-error +; (lambda () (use-modules (autoconfig))) +; (lambda (err caller fmt args . rest) +; (if (eqv? (caadr args) 'autoconfig) +; (format (current-error-port) "Run ./configure first~%") +; (format (current-error-port) "~?~%" fmt args)) +; (exit 1))) (use-modules (srfi srfi-1) (srfi srfi-88) ; keyword syntax (util) - ((util config) :select (set-config! get-configuration-documentation)) + ((util config) :select (set-config! get-config get-configuration-documentation)) (util options) ((util hooks) :select (shutdown-hook)) + (directories) (text markup) (ice-9 getopt-long) (ice-9 regex) + ((ice-9 popen) :select (open-input-pipe)) (statprof) (repl) @@ -60,7 +62,7 @@ "Can " (i "not") " be given with an equal after --option." (br) "Can be given multiple times.")) - (setup-zoneinfo) + (update-zoneinfo) (help (single-char #\h) (description "Print this help")))) @@ -159,12 +161,24 @@ (throw 'return) ) - ;; ((@ (cache) load-cache)) + (when (option-ref opts 'update-zoneinfo #f) + (let ((pipe + (let-env ((PREFIX (get-config 'path-prefix))) + (open-input-pipe (path-append libexec "/tzget"))))) - ;; (when (option-ref opts 'setup-zoneinfo #f) - ;; (get-config 'libexec)/tzget + ;; (define path (read-line pipe)) + (define names (string-split ((@ (ice-9 rdelim) read-line) pipe) #\space)) + ((@ (util io) with-atomic-output-to-file) + (path-append data-directory "/zoneinfo.scm") + (lambda () + (write `(set-config! 'tz-list ',names)) (newline) + (write `(set-config! 'last-zoneinfo-upgrade ,((@ (datetime) current-date))) (newline)))))) + + ;; always load zoneinfo if available. + (let ((z (path-append data-directory "/zoneinfo"))) + (when (file-exists? z) + (primitive-load z))) - ;; ) (let ((ropt (ornull (option-ref opts '() '()) '("term")))) diff --git a/module/output/ical.scm b/module/output/ical.scm index 203c6d0e..45918be0 100644 --- a/module/output/ical.scm +++ b/module/output/ical.scm @@ -170,7 +170,8 @@ (add-child! cal event) - (awhen (param (prop* event 'DTSTART) 'TZID) + (awhen (and (provided? 'zoneinfo) + (param (prop* event 'DTSTART) 'TZID)) ;; TODO this is broken (add-child! cal (zoneinfo->vtimezone (zoneinfo) it))) @@ -209,14 +210,15 @@ CALSCALE:GREGORIAN\r (print-header) - (let ((tz-names (get-tz-names events))) - (for-each component->ical-string - ;; TODO we realy should send the earliest event from each timezone here, - ;; instead of just the first. - (map (lambda (name) (zoneinfo->vtimezone - (zoneinfo) - name (car events))) - tz-names))) + (when (provided? 'zoneinfo) + (let ((tz-names (get-tz-names events))) + (for-each component->ical-string + ;; TODO we realy should send the earliest event from each timezone here, + ;; instead of just the first. + (map (lambda (name) (zoneinfo->vtimezone + (zoneinfo) + name (car events))) + tz-names)))) (for-each component->ical-string events) diff --git a/module/server/macro.scm b/module/server/macro.scm index 2fb87f54..41d23d34 100644 --- a/module/server/macro.scm +++ b/module/server/macro.scm @@ -60,7 +60,7 @@ (define-macro (make-routes . routes) `(lambda* (request body #:optional state) - (format (current-error-port) "~a~%" request) + ;; (format (current-error-port) "~a~%" request) ;; ALl these bindings generate compile time warnings since the expansion ;; of the macro might not use them. This isn't really a problem. (let ((r:method ((@ (web request) request-method) request)) diff --git a/module/util.scm b/module/util.scm index d5cf86a7..17400c3b 100644 --- a/module/util.scm +++ b/module/util.scm @@ -300,6 +300,12 @@ (if (> i (string-length str)) str (string-take str i))) +(define-public (string-first str) + (string-ref str 0)) + +(define-public (string-last str) + (string-ref str (1- (string-length str)))) + (define-public (as-symb s) (if (string? s) (string->symbol s) s)) @@ -546,6 +552,17 @@ +(define-syntax catch-warnings + (syntax-rules () + ((_ default body ...) + (parametrize ((warnings-are-errors #t)) + (catch 'warning + (lambda () + body ...) + (lambda _ default)))))) + + + (define-syntax let-env (syntax-rules () [(_ ((name value) ...) diff --git a/static/script.js b/static/script.js index 7303d1c6..0d1ed7e2 100644 --- a/static/script.js +++ b/static/script.js @@ -552,7 +552,7 @@ function place_in_edit_mode (event) { value: 'Skapa event', }); - let article = popup.getElementsByTagName("article")[0]; + let article = popup.getElementsByClassName("eventtext")[0]; article.appendChild(submit); @@ -5,6 +5,9 @@ # - the directory with the zoneinfo files # - the names of the zoneinfo files to be parsed +PREFIX=${PREFIX:-/usr} +DATA_DIR=${XDG_DATA_HOME:-$PREFIX/share}/calp/zoneinfo + # Where to savze the file CACHE_DIR=${CACHE_DIR:-~/.cache/calp} # Which file to get @@ -12,8 +15,8 @@ TAR=tzdata-latest.tar.gz # Where to get it from TZ_SRC="https://www.iana.org/time-zones/repository/$TAR" -mkdir -p $CACHE_DIR -cd $CACHE_DIR +mkdir -p $DATA_DIR +cd $DATA_DIR test -d "tzdata" || { test -f "/tmp/$TAR" || env --chdir=/tmp curl -sOL $TZ_SRC @@ -22,8 +25,7 @@ test -d "tzdata" || { } cd "tzdata" - -tzpath=$(pwd) +# tzpath=$(pwd) size=$(stat -c "%s" Makefile) @@ -36,5 +38,5 @@ files=$(make print-tdata) truncate -cs $size Makefile -echo $tzpath +# echo $tzpath echo $files |