diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-03-02 23:13:41 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-03-02 23:13:41 +0100 |
commit | 9a6586a0a33e97cdee8cb417556f033b9c6b93a0 (patch) | |
tree | ae40aca66ff9a12c785ff122f3c92168f89ddd66 /code.scm | |
parent | Add print-vcomponent procedure. (diff) | |
download | calp-9a6586a0a33e97cdee8cb417556f033b9c6b93a0.tar.gz calp-9a6586a0a33e97cdee8cb417556f033b9c6b93a0.tar.xz |
Move datetime stuff to better suited files.
Diffstat (limited to '')
-rwxr-xr-x | code.scm | 38 |
1 files changed, 2 insertions, 36 deletions
@@ -1,21 +1,16 @@ (define-module (code) - #:export (extract localize-date sort* drop-time! copy-date - drop-time %date<=? date-today? color-if + #:export (extract sort* color-if for-each-in STR-YELLOW STR-RESET print-vcomponent)) (use-modules (srfi srfi-19) - (srfi srfi-19 setters) + (srfi srfi-19 util) (srfi srfi-26) (vcalendar)) (define (extract field) (cut get-attr <> field)) -(define (localize-date date) - (time-utc->date (date->time-utc date) - (date-zone-offset (current-date)))) - ;;; 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" @@ -26,35 +21,6 @@ (define STR-YELLOW "\x1b[0;33m") (define STR-RESET "\x1b[m") -(define (drop-time! date) - (set! (hour date) 0) - (set! (minute date) 0) - (set! (second date) 0) - (set! (nanosecond date) 0) - date) - -(define (copy-date date) - (let* ((date-type (@@ (srfi srfi-19) date)) - (access (lambda (field) ((record-accessor date-type field) date)))) - (apply make-date (map access (record-type-fields date-type))))) - -(define (drop-time date) - (let ((new-date (copy-date date))) - (drop-time! new-date))) - -(define (%date<=? a b) - (time<=? (date->time-utc a) - (date->time-utc b))) - -(define (date-today? input-date) - (let* ((date (current-date)) - (now (drop-time date)) - (then (copy-date now))) - (set! (day then) - (1+ (day then))) - (and (%date<=? now input-date) - (%date<=? input-date then)))) - (define-syntax-rule (color-if pred color body ...) (let ((pred-value pred)) |