diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-04-07 22:12:29 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-04-07 22:12:29 +0200 |
commit | e377df7b305514d721510fe1f15921647ebc7552 (patch) | |
tree | 35dd17aaf5e29c44c0f13401b6cb86e4d7df5acd /module/vcomponent | |
parent | Rename filename-extension{ => ?}. (diff) | |
parent | Fix translation for (vcomponent datetime output). (diff) | |
download | calp-e377df7b305514d721510fe1f15921647ebc7552.tar.gz calp-e377df7b305514d721510fe1f15921647ebc7552.tar.xz |
Merge branch 'translation'
Diffstat (limited to '')
-rw-r--r-- | module/vcomponent/datetime/output.scm | 54 | ||||
-rw-r--r-- | module/vcomponent/formats/common/types.scm | 11 | ||||
-rw-r--r-- | module/vcomponent/formats/ical/output.scm | 3 | ||||
-rw-r--r-- | module/vcomponent/formats/ical/parse.scm | 29 | ||||
-rw-r--r-- | module/vcomponent/formats/ical/types.scm | 8 | ||||
-rw-r--r-- | module/vcomponent/formats/vdir/parse.scm | 3 | ||||
-rw-r--r-- | module/vcomponent/formats/vdir/save-delete.scm | 6 | ||||
-rw-r--r-- | module/vcomponent/formats/xcal/output.scm | 3 | ||||
-rw-r--r-- | module/vcomponent/formats/xcal/parse.scm | 5 | ||||
-rw-r--r-- | module/vcomponent/formats/xcal/types.scm | 3 | ||||
-rw-r--r-- | module/vcomponent/recurrence/display.scm | 154 | ||||
-rw-r--r-- | module/vcomponent/recurrence/display/common.scm | 6 | ||||
-rw-r--r-- | module/vcomponent/recurrence/display/en.scm | 131 | ||||
-rw-r--r-- | module/vcomponent/recurrence/display/sv.scm | 139 | ||||
-rw-r--r-- | module/vcomponent/util/instance.scm | 3 | ||||
-rw-r--r-- | module/vcomponent/util/instance/methods.scm | 14 | ||||
-rw-r--r-- | module/vcomponent/util/parse-cal-path.scm | 5 |
17 files changed, 383 insertions, 194 deletions
diff --git a/module/vcomponent/datetime/output.scm b/module/vcomponent/datetime/output.scm index 2b528423..fe909ebb 100644 --- a/module/vcomponent/datetime/output.scm +++ b/module/vcomponent/datetime/output.scm @@ -3,31 +3,52 @@ :use-module (datetime) :use-module (vcomponent base) :use-module (text util) + :use-module (calp translation) + :use-module ((vcomponent recurrence display) :select (format-recurrence-rule)) ) ;; ev → sxml +;; TODO translation (define-public (format-recurrence-rule ev) - `("Upprepas " - ,((@ (vcomponent recurrence display) format-recurrence-rule) - (prop ev 'RRULE)) + ;; [FRR] + ;; Part of the sentance "Repeated [every two weeks], except on ~a, ~a & ~a" + ;; See everything tagged [FRR] + `(,(_ "Repeated ") + ,(format-recurrence-rule (prop ev 'RRULE)) ,@(awhen (prop* ev 'EXDATE) (list - ", undantaget " + ;; See [FRR] + (_ ", except on ") (add-enumeration-punctuation (map (lambda (d) + ;; TODO show year if different from current year (if (date? d) - ;; NOTE possibly show year? - (date->string d "~e ~b") + ;; [FRR] Exception date without time + (date->string d (_ "~e ~b")) ;; NOTE only show time when it's different than the start time? ;; or possibly only when FREQ is hourly or lower. (if (memv ((@ (vcomponent recurrence internal) freq) - (prop ev 'RRULE)) - '(HOURLY MINUTELY SECONDLY)) - (datetime->string d "~e ~b ~k:~M") - (datetime->string d "~e ~b")))) + (prop ev 'RRULE)) + '(HOURLY MINUTELY SECONDLY)) + ;; [FRR] Exception date with time + (datetime->string d (_ "~e ~b ~k:~M")) + ;; [FRR] Exception date without time + (datetime->string d (_ "~e ~b"))))) (map value it))))) ".")) +(define-public (format-summary ev str) + ((get-config 'summary-filter) ev str)) + +;; NOTE this should have information about context (html/term/...) +(define-public (format-description ev str) + (catch #t (lambda () ((get-config 'description-filter) ev str)) + (lambda (err . args) + ;; Warning message for failure to format description. + ;; First argument is name of warning/error, + ;; second is error arguments + (warning (_ "~a on formatting description, ~s") err args) + str))) ;; Takes an event, and returns a pretty string for the time interval ;; the event occupies. @@ -37,9 +58,9 @@ (cond [(prop ev 'DTEND) => (lambda (e) (if (date= e (date+ s (date day: 1))) - "~Y-~m-~d" ; start = end, only return one value - (values "~Y-~m-~d" - "~Y-~m-~d")))] + (_ "~Y-~m-~d") ; start = end, only return one value + (values (_ "~Y-~m-~d") + (_ "~Y-~m-~d"))))] ;; no end value, just return start [else (date->string s)]))] [else ; guaranteed datetime @@ -47,6 +68,9 @@ (e (prop ev 'DTEND))) (if e (let ((fmt-str (if (date= (get-date s) (get-date e)) - "~H:~M" "~Y-~m-~d ~H:~M"))) + (_ "~H:~M") + ;; Note the non-breaking space + (_ "~Y-~m-~d ~H:~M")))) (values fmt-str fmt-str)) - "~Y-~m-~d ~H:~M"))])) + ;; Note the non-breaking space + (_ "~Y-~m-~d ~H:~M")))])) diff --git a/module/vcomponent/formats/common/types.scm b/module/vcomponent/formats/common/types.scm index 97980e1a..9e18f1eb 100644 --- a/module/vcomponent/formats/common/types.scm +++ b/module/vcomponent/formats/common/types.scm @@ -5,13 +5,14 @@ :use-module (datetime) :use-module (srfi srfi-9 gnu) :use-module (datetime timespec) + :use-module (calp translation) ) ;; BINARY (define (parse-binary props value) ;; p 30 (unless (string=? "BASE64" (hashq-ref props 'ENCODING)) - (warning "Binary field not marked ENCODING=BASE64")) + (warning (_ "Binary field not marked ENCODING=BASE64"))) ;; For icalendar no extra whitespace is allowed in a ;; binary field (except for line wrapping). This differs @@ -23,7 +24,7 @@ (cond [(string=? "TRUE" value) #t] [(string=? "FALSE" value) #f] - [else (warning "~a invalid boolean" value)])) + [else (warning (_ "~a invalid boolean") value)])) ;; CAL-ADDRESS ⇒ uri @@ -56,7 +57,7 @@ (define (parse-integer props value) (let ((n (string->number value))) (unless (integer? n) - (warning "Non integer as integer")) + (warning (_ "Non integer as integer"))) n)) ;; PERIOD @@ -87,7 +88,7 @@ (case (cadr rem) [(#\n #\N) (loop (cddr rem) (cons #\newline str) done)] [(#\; #\, #\\) => (lambda (c) (loop (cddr rem) (cons c str) done))] - [else => (lambda (c) (warning "Non-escapable character: ~a" c) + [else => (lambda (c) (warning (_ "Non-escapable character: ~a") c) (loop (cddr rem) str done))])] [(#\,) (loop (cdr rem) '() (cons (reverse-list->string str) done))] @@ -136,5 +137,5 @@ (define-public (get-parser type) (or (hashq-ref type-parsers type #f) - (scm-error 'misc-error "get-parser" "No parser for type ~a" + (scm-error 'misc-error "get-parser" (_ "No parser for type ~a") (list type) #f))) diff --git a/module/vcomponent/formats/ical/output.scm b/module/vcomponent/formats/ical/output.scm index fba8bffc..489cdc00 100644 --- a/module/vcomponent/formats/ical/output.scm +++ b/module/vcomponent/formats/ical/output.scm @@ -15,6 +15,7 @@ :use-module (vcomponent geo) :use-module (vcomponent formats ical types) :use-module (vcomponent recurrence) + :use-module (calp translation) :autoload (vcomponent util instance) (global-event-object) ) @@ -90,7 +91,7 @@ (get-writer 'TEXT)] [else - (warning "Unknown key ~a" key) + (warning (_ "Unknown key ~a") key) (get-writer 'TEXT)])) (catch #t #; 'wrong-type-arg diff --git a/module/vcomponent/formats/ical/parse.scm b/module/vcomponent/formats/ical/parse.scm index 08f31ae7..7f6c89cc 100644 --- a/module/vcomponent/formats/ical/parse.scm +++ b/module/vcomponent/formats/ical/parse.scm @@ -10,6 +10,7 @@ :use-module (vcomponent base) :use-module (vcomponent geo) :use-module (vcomponent formats common types) + :use-module (calp translation) ) (define string->symbol @@ -122,7 +123,7 @@ (let ((vv (parser params value))) (when (list? vv) (scm-error 'parse-error "enum-parser" - "List in enum field" + (_ "List in enum field") #f #f)) (let ((v (string->symbol vv))) (unless (memv v enum) @@ -158,7 +159,7 @@ (lambda (params value) (let ((v ((get-parser 'TEXT) params value))) (unless (= 1 (length v)) - (warning "List in non-list field: ~s" v)) + (warning (_ "List in non-list field: ~s") v)) (string-join v ",")))] ;; TEXT, but allow a list @@ -196,7 +197,7 @@ [(memv key '(REQUEST-STATUS)) (scm-error 'parse-error "build-vline" - "TODO Implement REQUEST-STATUS" + (_ "TODO Implement REQUEST-STATUS") #f #f)] [(memv key '(ACTION)) @@ -231,7 +232,7 @@ (compose car (get-parser 'TEXT))] [else - (warning "Unknown key ~a" key) + (warning (_ "Unknown key ~a") key) (compose car (get-parser 'TEXT))]))) ;; If we produced a list create multiple VLINES from it. @@ -278,9 +279,15 @@ (lambda (fmt . args) (let ((linedata (get-metadata head*))) (format - #f "WARNING parse error around ~a + #f + ;; arguments: + ;; linedata + ;; ~? + ;; source line + ;; source file + (_ "WARNING parse error around ~a ~? - line ~a ~a~%" + line ~a ~a~%") (get-string linedata) fmt args (get-line linedata) @@ -326,10 +333,16 @@ (lambda (err proc fmt fmt-args data) (let ((linedata (get-metadata head*))) (display (format - #f "ERROR parse error around ~a + #f + ;; arguments + ;; linedata + ;; ~? + ;; source line + ;; source file + (_ "ERROR parse error around ~a ~? line ~a ~a - Defaulting to string~%" + Defaulting to string~%") (get-string linedata) fmt fmt-args (get-line linedata) diff --git a/module/vcomponent/formats/ical/types.scm b/module/vcomponent/formats/ical/types.scm index 39b3b1e3..67f9f633 100644 --- a/module/vcomponent/formats/ical/types.scm +++ b/module/vcomponent/formats/ical/types.scm @@ -4,7 +4,9 @@ :use-module (hnh util exceptions) :use-module (base64) :use-module (datetime) - :use-module (datetime timespec)) + :use-module (datetime timespec) + :use-module (calp translation) + ) ;; TODO shouldn't these really take vline:s? @@ -35,7 +37,7 @@ ;; TODO (define (write-period _ value) - (warning "PERIOD writer not yet implemented") + (warning (_ "PERIOD writer not yet implemented")) (with-output-to-string (lambda () (write value)))) @@ -92,4 +94,4 @@ (define-public (get-writer type) (or (hashq-ref type-writers type #f) - (error "No writer for type" type))) + (error (_ "No writer for type") type))) diff --git a/module/vcomponent/formats/vdir/parse.scm b/module/vcomponent/formats/vdir/parse.scm index 272674ed..b21a5f2b 100644 --- a/module/vcomponent/formats/vdir/parse.scm +++ b/module/vcomponent/formats/vdir/parse.scm @@ -15,6 +15,7 @@ :use-module ((hnh util path) :select (path-append)) :use-module (hnh util exceptions) :use-module (vcomponent base) + :use-module (calp translation) :use-module (vcomponent formats ical parse) ) @@ -62,7 +63,7 @@ ;; by RECURRENCE-ID. As far as I can tell this goes against ;; the standard. Section 3.8.4.4. (case (length events) - [(0) (warning "No events in component~%~a" + [(0) (warning (_ "No events in component~%~a") (prop item '-X-HNH-FILENAME))] [(1) (add-child! calendar (car events))] diff --git a/module/vcomponent/formats/vdir/save-delete.scm b/module/vcomponent/formats/vdir/save-delete.scm index 96354ce8..01d34f9f 100644 --- a/module/vcomponent/formats/vdir/save-delete.scm +++ b/module/vcomponent/formats/vdir/save-delete.scm @@ -24,13 +24,13 @@ (unless calendar (scm-error 'wrong-type-arg "save-event" - "Can only save events belonging to calendars, event uid = ~s" + (_ "Can only save events belonging to calendars, event uid = ~s") (list (prop event 'UID)) #f)) (unless (eq? 'vdir (prop calendar '-X-HNH-SOURCETYPE)) (scm-error 'wrong-type-arg "save-event" - "Can only save events belonging to vdir calendars. Calendar is of type ~s" + (_ "Can only save events belonging to vdir calendars. Calendar is of type ~s") (list (prop calendar '-X-HNH-SOURCETYPE)) #f)) @@ -50,7 +50,7 @@ (define calendar (parent event)) (unless (eq? 'vdir (prop calendar '-X-HNH-SOURCETYPE)) (scm-error 'wrong-type-arg "remove-event" - "Can only remove events belonging to vdir calendars. Calendar is of type ~s" + (_ "Can only remove events belonging to vdir calendars. Calendar is of type ~s") (list (prop calendar '-X-HNH-SOURCETYPE)) #f)) (delete-file (prop event '-X-HNH-FILENAME))) diff --git a/module/vcomponent/formats/xcal/output.scm b/module/vcomponent/formats/xcal/output.scm index 81fab41c..26018d92 100644 --- a/module/vcomponent/formats/xcal/output.scm +++ b/module/vcomponent/formats/xcal/output.scm @@ -7,6 +7,7 @@ :use-module (ice-9 match) :use-module (datetime) :use-module (srfi srfi-1) + :use-module (calp translation) ) @@ -69,7 +70,7 @@ (get-writer 'TEXT)] [else - (warning "Unknown key ~a" key) + (warning (_ "Unknown key ~a") key) (get-writer 'TEXT)])) (writer ((@@ (vcomponent base) get-vline-parameters) vline) (value vline))) diff --git a/module/vcomponent/formats/xcal/parse.scm b/module/vcomponent/formats/xcal/parse.scm index b21e72b5..d9020858 100644 --- a/module/vcomponent/formats/xcal/parse.scm +++ b/module/vcomponent/formats/xcal/parse.scm @@ -9,6 +9,7 @@ :use-module (vcomponent formats common types) :use-module (datetime) :use-module (srfi srfi-1) + :use-module (calp translation) ) ;; symbol, ht, (list a) -> non-list @@ -82,7 +83,7 @@ bymonth bysetpos) (string->number value)) (else (scm-error 'key-error "handle-value" - "Invalid type ~a, with value ~a" + (_ "Invalid type ~a, with value ~a") (list type value) #f)))))) @@ -155,7 +156,7 @@ (case tag-name [(request-status) ;; TODO - (warning "Request status not yet implemented") + (warning (_ "Request status not yet implemented")) #f] ((transp) (parse-enum diff --git a/module/vcomponent/formats/xcal/types.scm b/module/vcomponent/formats/xcal/types.scm index 05fbc8c6..8f13d3d1 100644 --- a/module/vcomponent/formats/xcal/types.scm +++ b/module/vcomponent/formats/xcal/types.scm @@ -2,6 +2,7 @@ :use-module (hnh util) :use-module (vcomponent formats ical types) :use-module (datetime) + :use-module (calp translation) ) (define (write-boolean _ v) @@ -51,4 +52,4 @@ (define-public (get-writer type) (or (hashq-ref sxml-writers type #f) - (error "No writer for type" type))) + (error (_ "No writer for type") type))) diff --git a/module/vcomponent/recurrence/display.scm b/module/vcomponent/recurrence/display.scm index f5ce1c57..8a9f33e6 100644 --- a/module/vcomponent/recurrence/display.scm +++ b/module/vcomponent/recurrence/display.scm @@ -1,146 +1,10 @@ -;;; Commentary: -;; Pretty print a recurrence rule (in Swedish). Is currently missing a -;; number of ;; edge cases, and even more concerning limited events. -;; NOTE It would be preferable if this could share as much logic as possible -;; with the "real" generator. -;;; Code: - (define-module (vcomponent recurrence display) - :use-module (hnh util) - :use-module (vcomponent recurrence internal) - :use-module (text util) - :use-module (text numbers sv) - :use-module ((datetime) :select (time time->string - datetime->string - week-day-name - locale-month - )) - ) - - -(define (rrule-month->string n) - (locale-month n)) - -;; TODO this currently only groups on offsets, but not on days. -;; So 1MO, 1TU becomes "första måndagen och tisdagen", which is good -;; but 1MO, -1MO doesn't become "första och sista måndagen". -;; TODO also, grouping of -dagen. e.g. "första mån- och tisdagen" -(define (format-byday-list lst) - (let* ((groups (group-by car lst))) - (intersperse - " samt " - (map (lambda (group) - ;; TODO sort week days - (case (car group) - [(#f) - (list "varje " - (add-enumeration-punctuation - (map (lambda (d) (list (week-day-name (cdr d)))) - (cadr group) - )))] - [else - (list (number->string-ordinal - (car group) - a-form?: #t) - " " - (add-enumeration-punctuation - (map (lambda (d) (list (week-day-name (cdr d)) "en")) - (cadr group))))]) - ) - groups)))) - -(define* (format-bymonth-day lst optional: (final-delim "&")) - (list "den " - (add-enumeration-punctuation - (map number->string-ordinal lst) - final-delim))) - - -(define-public (format-recurrence-rule rrule) - (string-trim - (string-flatten - (list - (case (freq rrule) - [(YEARLY) - (list (awhen (byday rrule) (list " " (format-byday-list it))) - (awhen (bymonthday rrule) (list " " (format-bymonth-day it "eller"))) - (awhen (byyearday rrule) - (list " dag " (add-enumeration-punctuation it))) - (awhen (bymonth rrule) - ;; only `i' here if we have output something else beforehand - (list (when (or (byday rrule) - (bymonthday rrule) - (byyearday rrule)) - " i ") - (add-enumeration-punctuation - (map rrule-month->string it)))) - (awhen (byweekno rrule) - (map (lambda (v) (format #f " v.~a" v)) it)) - )] - [(MONTHLY) - (list - (awhen (byday rrule) (list (format-byday-list it))) - (awhen (bymonthday rrule) (cons " " (format-bymonth-day it))))] - [else '()]) - - ;; TODO my parser adds an implicit interval to every object - ;; this might be wrong - (cond [(and (eq? 'DAILY (freq rrule)) (= 1 (interval rrule))) - " dagligen"] - [(and (eq? 'YEARLY (freq rrule)) (= 1 (interval rrule))) - ", årligen"] - [(and (eq? 'MINUTELY (freq rrule)) - (zero? (modulo (interval rrule) 15))) - (list " " - (each-string (/ (interval rrule) 15)) - " kvart")] - [else - (list - " " - (each-string (interval rrule) (eq? 'YEARLY (freq rrule))) - " " - (case (freq rrule) - ;; p.44 RFC 5545 - [(SECONDLY) "sekund"] - [(MINUTELY) "minut"] - [(HOURLY) "timme"] - [(DAILY) "dag"] - - ;; day offsets CAN ONLY be present when FREQ is - ;; either MONTHLY or YEARLY - [(WEEKLY) (aif (byday rrule) - (add-enumeration-punctuation - (map (compose week-day-name cdr) it)) - "vecka")] - [(MONTHLY) "månad"] - [(YEARLY) "år"] - [else "ERROR"] - ))]) - - (cond [(and (byminute rrule) - (byhour rrule)) - (list - " kl. " - (add-enumeration-punctuation - (map (lambda (pair) - (time->string - (time hour: (car pair) - minute: (cadr pair)) - "~H:~M")) - (cross-product (byhour rrule) - (byminute rrule)))))] - [(byhour rrule) - => (lambda (hours) - (list " kl. " (add-enumeration-punctuation hours)))] - [else '()]) - - (awhen (until rrule) - (format #f ", till och med ~a" - (datetime->string - ;; TODO ordinal on ~d? - it "den ~d ~B, ~Y kl. ~k:~M") - )) - (cond [(not (count rrule)) ""] - [(= 1 (count rrule)) (list ", totalt " (count rrule) " gång")] - [(count rrule) (list ", totalt " (count rrule) " gånger")] - [else "ERROR"]))))) + :use-module (vcomponent recurrence display common) + :use-module (hnh util language) + :re-export (rrule-month->string) + :export (format-recurrence-rule)) + +(define* (format-recurrence-rule rrule #:optional (language (resolve-language))) + ((module-ref (resolve-interface `(vcomponent recurrence display ,language)) + 'format-recurrence-rule) + rrule)) diff --git a/module/vcomponent/recurrence/display/common.scm b/module/vcomponent/recurrence/display/common.scm new file mode 100644 index 00000000..c9d0f5e1 --- /dev/null +++ b/module/vcomponent/recurrence/display/common.scm @@ -0,0 +1,6 @@ +(define-module (vcomponent recurrence display common) + :use-module ((datetime) :select (locale-month)) + :export (rrule-month->string)) + +(define (rrule-month->string n) + (locale-month n)) diff --git a/module/vcomponent/recurrence/display/en.scm b/module/vcomponent/recurrence/display/en.scm new file mode 100644 index 00000000..be9bdf53 --- /dev/null +++ b/module/vcomponent/recurrence/display/en.scm @@ -0,0 +1,131 @@ +(define-module (vcomponent recurrence display en) + :use-module (hnh util) + :use-module (vcomponent recurrence internal) + :use-module (text util) + :use-module (text numbers) + :use-module (vcomponent recurrence display common) + :use-module ((datetime) :select (time time->string + datetime->string + week-day-name))) + + + +;; TODO this currently only groups on offsets, but not on days. +;; So 1MO, 1TU becomes "första måndagen och tisdagen", which is good +;; but 1MO, -1MO doesn't become "första och sista måndagen". +;; TODO also, grouping of -dagen. e.g. "första mån- och tisdagen" +(define (format-byday-list lst) + (let* ((groups (group-by car lst))) + (intersperse + " as well as " + (map (lambda (group) + ;; TODO sort week days + (case (car group) + [(#f) + (list "every " + (add-enumeration-punctuation + (map (lambda (d) (list (week-day-name (cdr d)))) + (cadr group) + )))] + [else + (list (number->string-ordinal (car group)) " " + (add-enumeration-punctuation + (map (lambda (d) (list (week-day-name (cdr d)) "en")) + (cadr group))))]) + ) + groups)))) + +(define (format-bymonth-day lst) + (list "the " + (add-enumeration-punctuation + (map number->string-ordinal lst)))) + + +(define-public (format-recurrence-rule rrule) + (string-trim + (string-flatten + (list + (case (freq rrule) + [(YEARLY) + (list (awhen (byday rrule) (list " " (format-byday-list it))) + (awhen (bymonthday rrule) (list " " (format-bymonth-day it))) + (awhen (byyearday rrule) + (list " day " (add-enumeration-punctuation it))) + (awhen (bymonth rrule) + ;; only `i' here if we have output something else beforehand + (list (when (or (byday rrule) + (bymonthday rrule) + (byyearday rrule)) + " in ") + (add-enumeration-punctuation + (map rrule-month->string it)))) + (awhen (byweekno rrule) + (map (lambda (v) (format #f " v.~a" v)) it)) + )] + [(MONTHLY) + (list + (awhen (byday rrule) (list (format-byday-list it))) + (awhen (bymonthday rrule) (format-bymonth-day it)))] + [else '()]) + + ;; TODO my parser adds an implicit interval to every object + ;; this might be wrong + (cond [(and (eq? 'DAILY (freq rrule)) (= 1 (interval rrule))) + " daily"] + [(and (eq? 'YEARLY (freq rrule)) (= 1 (interval rrule))) + ", yearly"] + [(and (eq? 'MINUTELY (freq rrule)) + (zero? (modulo (interval rrule) 15))) + (list " " + (each-string (/ (interval rrule) 15)) + " 15 minutes")] + [else + (list + " " + (each-string (interval rrule) (eq? 'YEARLY (freq rrule))) + " " + (case (freq rrule) + ;; p.44 RFC 5545 + [(SECONDLY) "second"] + [(MINUTELY) "minute"] + [(HOURLY) "hour"] + [(DAILY) "day"] + + ;; day offsets CAN ONLY be present when FREQ is + ;; either MONTHLY or YEARLY + [(WEEKLY) (aif (byday rrule) + (add-enumeration-punctuation + (map (compose week-day-name cdr) it)) + "week")] + [(MONTHLY) "month"] + [(YEARLY) "year"] + [else "ERROR"] + ))]) + + (cond [(and (byminute rrule) + (byhour rrule)) + (list + " at " + (add-enumeration-punctuation + (map (lambda (pair) + (time->string + (time hour: (car pair) + minute: (cdr pair)) + "~H:~M")) + (cross-product (byhour rrule) + (byminute rrule)))))] + [(byhour rrule) + => (lambda (hours) + (list " at " (add-enumeration-punctuation hours)))] + [else '()]) + + (awhen (until rrule) + (format #f ", until ~a" + (datetime->string + ;; TODO ordinal on ~d? + it "~B ~d, ~Y at ~k:~M") + )) + (cond [(not (count rrule)) ""] + [(= 1 (count rrule)) (list ", " (count rrule) " time in total")] + [(count rrule) (list ", " (count rrule) " times in total")] + [else "ERROR"]))))) diff --git a/module/vcomponent/recurrence/display/sv.scm b/module/vcomponent/recurrence/display/sv.scm new file mode 100644 index 00000000..fe580474 --- /dev/null +++ b/module/vcomponent/recurrence/display/sv.scm @@ -0,0 +1,139 @@ +;;; Commentary: +;; Pretty print a recurrence rule (in Swedish). Is currently missing a +;; number of ;; edge cases, and even more concerning limited events. +;; NOTE It would be preferable if this could share as much logic as possible +;; with the "real" generator. +;;; Code: + +(define-module (vcomponent recurrence display sv) + :use-module (hnh util) + :use-module (vcomponent recurrence internal) + :use-module (text util) + :use-module (text numbers sv) + :use-module (vcomponent recurrence display common) + :use-module ((datetime) :select (time time->string + datetime->string + week-day-name))) + +;; TODO this currently only groups on offsets, but not on days. +;; So 1MO, 1TU becomes "första måndagen och tisdagen", which is good +;; but 1MO, -1MO doesn't become "första och sista måndagen". +;; TODO also, grouping of -dagen. e.g. "första mån- och tisdagen" +(define (format-byday-list lst) + (let* ((groups (group-by car lst))) + (intersperse + " samt " + (map (lambda (group) + ;; TODO sort week days + (case (car group) + [(#f) + (list "varje " + (add-enumeration-punctuation + (map (lambda (d) (list (week-day-name (cdr d)))) + (cadr group) + )))] + [else + (list (number->string-ordinal + (car group) + a-form?: #t) + " " + (add-enumeration-punctuation + (map (lambda (d) (list (week-day-name (cdr d)) "en")) + (cadr group))))]) + ) + groups)))) + +(define* (format-bymonth-day lst optional: (final-delim "&")) + (list "den " + (add-enumeration-punctuation + (map number->string-ordinal lst) + final-delim))) + +(define-public (format-recurrence-rule rrule) + (string-trim + (string-flatten + (list + (case (freq rrule) + [(YEARLY) + (list (awhen (byday rrule) (list " " (format-byday-list it))) + (awhen (bymonthday rrule) (list " " (format-bymonth-day it "eller"))) + (awhen (byyearday rrule) + (list " dag " (add-enumeration-punctuation it))) + (awhen (bymonth rrule) + ;; only `i' here if we have output something else beforehand + (list (when (or (byday rrule) + (bymonthday rrule) + (byyearday rrule)) + " i ") + (add-enumeration-punctuation + (map rrule-month->string it)))) + (awhen (byweekno rrule) + (map (lambda (v) (format #f " v.~a" v)) it)) + )] + [(MONTHLY) + (list + (awhen (byday rrule) (list (format-byday-list it))) + (awhen (bymonthday rrule) (cons " " (format-bymonth-day it))))] + [else '()]) + + ;; TODO my parser adds an implicit interval to every object + ;; this might be wrong + (cond [(and (eq? 'DAILY (freq rrule)) (= 1 (interval rrule))) + " dagligen"] + [(and (eq? 'YEARLY (freq rrule)) (= 1 (interval rrule))) + ", årligen"] + [(and (eq? 'MINUTELY (freq rrule)) + (zero? (modulo (interval rrule) 15))) + (list " " + (each-string (/ (interval rrule) 15)) + " kvart")] + [else + (list + " " + (each-string (interval rrule) (eq? 'YEARLY (freq rrule))) + " " + (case (freq rrule) + ;; p.44 RFC 5545 + [(SECONDLY) "sekund"] + [(MINUTELY) "minut"] + [(HOURLY) "timme"] + [(DAILY) "dag"] + + ;; day offsets CAN ONLY be present when FREQ is + ;; either MONTHLY or YEARLY + [(WEEKLY) (aif (byday rrule) + (add-enumeration-punctuation + (map (compose week-day-name cdr) it)) + "vecka")] + [(MONTHLY) "månad"] + [(YEARLY) "år"] + [else "ERROR"] + ))]) + + (cond [(and (byminute rrule) + (byhour rrule)) + (list + " kl. " + (add-enumeration-punctuation + (map (lambda (pair) + (time->string + (time hour: (car pair) + minute: (cadr pair)) + "~H:~M")) + (cross-product (byhour rrule) + (byminute rrule)))))] + [(byhour rrule) + => (lambda (hours) + (list " kl. " (add-enumeration-punctuation hours)))] + [else '()]) + + (awhen (until rrule) + (format #f ", till och med ~a" + (datetime->string + ;; TODO ordinal on ~d? + it "den ~d ~B, ~Y kl. ~k:~M") + )) + (cond [(not (count rrule)) ""] + [(= 1 (count rrule)) (list ", totalt " (count rrule) " gång")] + [(count rrule) (list ", totalt " (count rrule) " gånger")] + [else "ERROR"]))))) diff --git a/module/vcomponent/util/instance.scm b/module/vcomponent/util/instance.scm index 6e1e765f..d17b672a 100644 --- a/module/vcomponent/util/instance.scm +++ b/module/vcomponent/util/instance.scm @@ -2,6 +2,7 @@ :use-module (hnh util) :use-module ((calp util config) :select (get-config)) :use-module ((oop goops) :select (make)) + :use-module (calp translation) :export (global-event-object) ) @@ -18,5 +19,5 @@ (define-public (reload) (let ((new-value (make (@@ (vcomponent util instance methods) <events>) calendar-files: (get-config 'calendar-files)))) - (display "Reload done\n" (current-error-port)) + (format (current-error-port) (_ "Reload done~%")) (set! global-event-object new-value))) diff --git a/module/vcomponent/util/instance/methods.scm b/module/vcomponent/util/instance/methods.scm index 1edad44b..57d12f6b 100644 --- a/module/vcomponent/util/instance/methods.scm +++ b/module/vcomponent/util/instance/methods.scm @@ -12,6 +12,8 @@ :use-module ((vcomponent datetime) :select (ev-time<?)) :use-module (oop goops) + :use-module (calp translation) + :export (add-event remove-event @@ -70,7 +72,7 @@ (define-method (initialize (this <events>) args) (next-method) - (format (current-error-port) "Building <events> from~%") + (format (current-error-port) (_ "Building <events> from~%")) (for calendar in (slot-ref this 'calendar-files) (format (current-error-port) " - ~a~%" calendar)) @@ -185,13 +187,13 @@ ;; save-event sets -X-HNH-FILENAME from the UID. This is fine ;; since the two events are guaranteed to have the same UID. (unless ((@ (vcomponent formats vdir save-delete) save-event) event) - (throw 'misc-error "Saving event to disk failed.")) + (throw 'misc-error (_ "Saving event to disk failed."))) (unless (eq? calendar (parent old-event)) ;; change to a new calendar (format (current-error-port) - "Unlinking old event from ~a~%" + (_ "Unlinking old event from ~a~%") (prop old-event '-X-HNH-FILENAME)) ;; NOTE that this may fail, leading to a duplicate event being ;; created (since we save beforehand). This is just a minor problem @@ -201,7 +203,7 @@ (format (current-error-port) - "Event updated ~a~%" (prop event 'UID)))] + (_ "Event updated ~a~%") (prop event 'UID)))] [else (add-event this calendar event) @@ -211,7 +213,7 @@ ;; NOTE Posibly defer save to a later point. ;; That would allow better asyncronous preformance. (unless ((@ (vcomponent formats vdir save-delete) save-event) event) - (throw 'misc-error "Saving event to disk failed.")) + (throw 'misc-error (_ "Saving event to disk failed."))) (format (current-error-port) - "Event inserted ~a~%" (prop event 'UID))])) + (_ "Event inserted ~a~%") (prop event 'UID))])) diff --git a/module/vcomponent/util/parse-cal-path.scm b/module/vcomponent/util/parse-cal-path.scm index df3fbf75..4baa647e 100644 --- a/module/vcomponent/util/parse-cal-path.scm +++ b/module/vcomponent/util/parse-cal-path.scm @@ -2,6 +2,7 @@ :use-module (hnh util) :use-module ((calp util time) :select (report-time!)) :use-module (vcomponent base) + :use-module (calp translation) :use-module ((vcomponent formats ical parse) :select (parse-calendar)) :use-module ((vcomponent formats vdir parse) @@ -19,14 +20,14 @@ (set! (prop comp '-X-HNH-SOURCETYPE) 'file) comp) ] [(directory) - (report-time! "Parsing ~a" path) + (report-time! (_ "Parsing ~a") path) (let ((comp (parse-vdir path))) (set! (prop comp '-X-HNH-SOURCETYPE) 'vdir (prop comp '-X-HNH-DIRECTORY) path) comp)] [(block-special char-special fifo socket unknown symlink) => (lambda (t) (scm-error 'misc-error "parse-cal-path" - "Can't parse file of type ~s" + (_ "Can't parse file of type ~s") (list t) #f))])) |