aboutsummaryrefslogtreecommitdiff
path: root/module/calp
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2022-04-07 22:12:29 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2022-04-07 22:12:29 +0200
commite377df7b305514d721510fe1f15921647ebc7552 (patch)
tree35dd17aaf5e29c44c0f13401b6cb86e4d7df5acd /module/calp
parentRename filename-extension{ => ?}. (diff)
parentFix translation for (vcomponent datetime output). (diff)
downloadcalp-e377df7b305514d721510fe1f15921647ebc7552.tar.gz
calp-e377df7b305514d721510fe1f15921647ebc7552.tar.xz
Merge branch 'translation'
Diffstat (limited to 'module/calp')
-rw-r--r--module/calp/entry-points/benchmark.scm8
-rw-r--r--module/calp/entry-points/convert.scm13
-rw-r--r--module/calp/entry-points/html.scm51
-rw-r--r--module/calp/entry-points/ical.scm8
-rw-r--r--module/calp/entry-points/import.scm38
-rw-r--r--module/calp/entry-points/server.scm38
-rw-r--r--module/calp/entry-points/terminal.scm7
-rw-r--r--module/calp/entry-points/text.scm15
-rw-r--r--module/calp/entry-points/tidsrapport.scm24
-rw-r--r--module/calp/html/caltable.scm4
-rw-r--r--module/calp/html/components.scm3
-rw-r--r--module/calp/html/config.scm5
-rw-r--r--module/calp/html/util.scm5
-rw-r--r--module/calp/html/vcomponent.scm103
-rw-r--r--module/calp/html/view/calendar.scm53
-rw-r--r--module/calp/html/view/calendar/week.scm9
-rw-r--r--module/calp/html/view/search.scm13
-rw-r--r--module/calp/main.scm118
-rw-r--r--module/calp/repl.scm11
-rw-r--r--module/calp/server/routes.scm40
-rw-r--r--module/calp/server/server.scm1
-rw-r--r--module/calp/terminal.scm55
-rw-r--r--module/calp/translation.scm20
-rw-r--r--module/calp/util/config.scm14
-rw-r--r--module/calp/util/exceptions.scm3
25 files changed, 383 insertions, 276 deletions
diff --git a/module/calp/entry-points/benchmark.scm b/module/calp/entry-points/benchmark.scm
index 5db9b9df..31ea958a 100644
--- a/module/calp/entry-points/benchmark.scm
+++ b/module/calp/entry-points/benchmark.scm
@@ -5,6 +5,8 @@
:use-module (hnh util options)
:use-module ((srfi srfi-41) :select (stream->list))
+ :use-module (calp translation)
+
:use-module ((vcomponent util instance methods) :select (get-event-set))
:autoload (vcomponent util instance) (global-event-object)
@@ -15,9 +17,9 @@
(define opt-spec
`((enable-output (single-char #\o)
(description
- "Output is be default supressed, since many fields contain way to much data "
- "to read. This turns it on again."))
- (help (single-char #\h) (description "Print this help."))))
+ ,(_ "Output is by default supressed, since many fields contain way to much data to read. This turns it on again.")
+ ))
+ (help (single-char #\h) (description ,(_ "Print this help.")))))
(define (main args)
diff --git a/module/calp/entry-points/convert.scm b/module/calp/entry-points/convert.scm
index 1ce33d9c..d416b004 100644
--- a/module/calp/entry-points/convert.scm
+++ b/module/calp/entry-points/convert.scm
@@ -4,18 +4,19 @@
:use-module (hnh util options)
:use-module (ice-9 getopt-long)
:use-module (sxml simple)
+ :use-module (calp translation)
)
(define opt-spec
- `((from (single-char #\f) (value (options "xcal" "ical"))
- (description "Input format (infered from " (i "infile") ")"))
+ `((from (single-char #\f) (value (options "xcal" "ical"))
+ (description ,(xml->sxml (_ "<group>Input format (otherwise infered from <i>infile</i>)</group>"))))
(to (single-char #\t) (value (options "xcal" "ical"))
- (description "Output format (infered from " (i "outfile") ")"))
- (infile (value #t) (single-char #\i) (description "Input file"))
- (outfile (value #t) (single-char #\o) (description "Output file"))
- (help (single-char #\h) (description "Print this help."))))
+ (description ,(xml->sxml (_ "<group>Output format (otherwise infered from <i>outfile</i>)</group>"))))
+ (infile (value #t) (single-char #\i) (description ,(_ "Input file")))
+ (outfile (value #t) (single-char #\o) (description ,(_ "Output file")))
+ (help (single-char #\h) (description ,(_ "Print this help.")))))
(define (filename-to-type filename)
diff --git a/module/calp/entry-points/html.scm b/module/calp/entry-points/html.scm
index 04b09cf3..8478aa6c 100644
--- a/module/calp/entry-points/html.scm
+++ b/module/calp/entry-points/html.scm
@@ -19,9 +19,10 @@
:use-module ((vcomponent util instance methods)
:select (get-calendars get-event-set))
- :use-module ((sxml simple) :select (sxml->xml))
+ :use-module ((sxml simple) :select (sxml->xml xml->sxml))
:use-module ((sxml transformations) :select (href-transformer))
:use-module ((xdg basedir) :prefix xdg-)
+ :use-module (calp translation)
:autoload (vcomponent util instance) (global-event-object)
)
@@ -29,39 +30,35 @@
(define opt-spec
`((from (value #t) (single-char #\F)
- (description "Start date of output.")
+ (description ,(_ "Start date of output."))
)
(count (value #t)
- (description "How many pages should be rendered."
- "If --style=" (b "week") " and --from=" (b "2020-04-27")
- " then --count=" (b 4) " would render the four pages "
- "2020-04-27, 2020-05-04, 2020-05-11, and 2020-05-25. "
- "Defaults to 12 to give a whole year when --style=" (b "month") "."
- ))
+ (description ,(xml->sxml (_ "<group>How many pages should be rendered.
+If --style=<b>week</b> and --from=<b>2020-04-27</b>;
+then --count=<b>4</b> would render the four pages
+2020-04-27, 2020-05-04, 2020-05-11, and 2020-05-25.
+Defaults to 12 to give a whole year when --style=<b>month</b></group>"))))
(target (single-char #\t) (value #t)
- (description "Directory where html files should end up. Default to " (b "./html")))
+ (description ,(xml->sxml (_ "<group>Directory where html files should end up. Default to <b>./html</b></group>"))))
(style (value #t) (predicate ,(lambda (v) (memv (string->symbol v)
'(small wide week table))))
- (description "How the body of the HTML page should be layed out. "
- (br) (b "week")
- " gives a horizontally scrolling page with 7 elements, "
- "where each has events graphically laid out hour by hour."
- (br) (b "table")
- " gives a month in overview as a table. Each block contains "
- "the events for the given day, in order of start time. They are "
- "however not graphically sized. "
- (br) (b "wide")
- " is the same as week, but gives a full month.")
- )
+ (description ,(xml->sxml (_ "<group>How the body of the HTML page should be layed out.
+<br/><b>week</b>
+gives a horizontally scrolling page with 7 elements, where each has events
+graphically laid out hour by hour.
+<br/><b>table</b>
+gives a month in overview as a table. Each block contains the events for the
+given day, in order of start time. They are however not graphically sized.
+<br/><b>wide</b>
+is the same as week, but gives a full month.</group>"))))
(standalone
- (description "Creates a standalone document instead of an HTML fragment "
- "for embedding in a larger page. Currently only applies to the "
- (i "small") "style"))
+ (description ,(xml->sxml (_ "<group>Creates a standalone document instead of an HTML fragment
+for embedding in a larger page. Currently only applies to the <i>small</i> style</group>"))))
- (help (single-char #\h) (description "Print this help."))))
+ (help (single-char #\h) (description ,(_ "Print this help.")))))
@@ -115,7 +112,7 @@
(stream-for-each
(lambda (start-date)
(define fname (path-append target-directory (date->string start-date "~1.xml")))
- (format (current-error-port) "Writing to [~a]~%" fname)
+ (format (current-error-port) (_ "Writing to [~a]~%") fname)
(with-output-to-file fname
(lambda () (sxml->xml (re-root-static
(apply html-generate
@@ -183,7 +180,7 @@
pre-start: (start-of-week start)
post-end: (end-of-week (end-of-month start)))]
[else
- (scm-error 'misc-error "html-main" "Unknown html style: ~a" (list style) #f)])
+ (scm-error 'misc-error "html-main" (_ "Unknown html style: ~a") (list style) #f)])
- ((@ (calp util time) report-time!) "all done")
+ ((@ (calp util time) report-time!) (_ "all done"))
)
diff --git a/module/calp/entry-points/ical.scm b/module/calp/entry-points/ical.scm
index 938b0b35..e164c340 100644
--- a/module/calp/entry-points/ical.scm
+++ b/module/calp/entry-points/ical.scm
@@ -5,14 +5,16 @@
:use-module (vcomponent formats ical output)
:use-module (ice-9 getopt-long)
:use-module (datetime)
+ :use-module (calp translation)
+ :use-module (calp translation)
)
(define opt-spec
- '((from (value #t) (single-char #\F))
+ `((from (value #t) (single-char #\F))
(to (value #t) (single-char #\T)
- (description "Returns all elements between these two dates."))
+ (description ,(_ "Returns all elements between these two dates.")))
(help (single-char #\h)
- (description "Print this help."))))
+ (description ,(_ "Print this help.")))))
(define (main args)
(define opts (getopt-long args (getopt-opt opt-spec)))
diff --git a/module/calp/entry-points/import.scm b/module/calp/entry-points/import.scm
index 213a720d..cb8b9485 100644
--- a/module/calp/entry-points/import.scm
+++ b/module/calp/entry-points/import.scm
@@ -12,16 +12,17 @@
:use-module (vcomponent)
;; :use-module ((vcomponent formats ical parse) :select (parse-cal-path))
:use-module ((vcomponent util parse-cal-path) :select (parse-cal-path))
+ :use-module (calp translation)
:autoload (vcomponent util instance) (global-event-object)
)
(define options
- '((calendar (value #t) (single-char #\c)
- (description "Name of calendar to import into"))
+ `((calendar (value #t) (single-char #\c)
+ (description ,(_ "Name of calendar to import into")))
(file (value #t) (single-char #\f)
- (description "ics file to import"))
+ (description ,(_ "ics file to import")))
(help (single-char #\h)
- (description "Print this help."))))
+ (description ,(_ "Print this help.")))))
(define (main args)
(define opts (getopt-long args (getopt-opt options)))
@@ -40,27 +41,24 @@
(get-calendars global-event-object)))))
(unless calendar
- (format (current-error-port) "No calendar named ~s~%" cal-name)
+ (format (current-error-port) (_ "No calendar named ~s~%") cal-name)
(throw 'return))
(let ((new-events (parse-cal-path fname)))
- (format #t "About to the following ~a events into ~a~%~{~a~^~%~}~%"
+ (format #t (_ "About to import the following ~a events into ~a~%")
(length (children new-events))
- (prop calendar 'NAME)
+ (prop calendar 'NAME))
+ (format #t "~{~a~^~%~}~%"
(map (extract 'SUMMARY) (children new-events)))
- (format #t "Continue? [Y/n] ")
+ (format #t (_ "Continue? [Y/n] "))
- (let loop ((c #\space))
- (case c
- [(#\n #\N) (throw 'return)]
- [(#\y #\Y) (map (lambda (e)
- (add-event calendar e)
- (save-event e))
- (children new-events))]
- [else
- (let ((line (read-line)))
- (loop (if (string-null? line)
- #\Y (string-ref line 0))))]))
- )))
+ (let loop ((line (read-line)))
+ (case (if (string-null? line) 'yes (yes-no-check line))
+ [(no) (throw 'return)]
+ [(yes) (map (lambda (e)
+ (add-event calendar e)
+ (save-event e))
+ (children new-events))]
+ [else (loop line (read-line))])))))
diff --git a/module/calp/entry-points/server.scm b/module/calp/entry-points/server.scm
index 4c5637f3..1888a8a7 100644
--- a/module/calp/entry-points/server.scm
+++ b/module/calp/entry-points/server.scm
@@ -7,6 +7,8 @@
:use-module (ice-9 getopt-long)
:use-module (ice-9 format)
+ :use-module (calp translation)
+ :use-module (sxml simple)
:use-module ((calp server server) :select (start-server))
@@ -14,25 +16,23 @@
(define options
- '((port (value #t) (single-char #\p)
- (description "Bind to TCP port, defaults to " (i 8080) "."
- (br) "Can also be set through the config variable "
- (i "port") "."))
+ `((port (value #t) (single-char #\p)
+ (description ,(xml->sxml (_ "<group>Bind to TCP port, defaults to <i>8080</i>.
+<br/>Can also be set through the config variable
+<i>port</i>.</group>"))))
(addr (value #t)
-
- (description "Address to use, defaults to " (i "0.0.0.0")
- " for IPv4, and " (i "[::]") " for IPv6.")
- )
+ (description ,(xml->sxml (_ "<group>Address to use, defaults to <i>0.0.0.0</i> for IPv4,
+and <i>[::]</i> for IPv6</group>"))))
;; numbers as single-char doesn't work.
- (six (description "Use IPv6."))
- (four (description "Use IPv4."))
- (sigusr (description "Reload events on SIGUSR1"))
+ (six (description ,(_ "Use IPv6.")))
+ (four (description ,(_ "Use IPv4.")))
+ (sigusr (description ,(_ "Reload events on SIGUSR1")))
(help (single-char #\h)
- (description "Print this help."))))
+ (description ,(_ "Print this help.")))))
(define-config port 8080
- description: "Port to which the web server should bind.")
+ description: (_ "Port to which the web server should bind."))
(define-public (main args)
@@ -61,18 +61,22 @@
"::" "0.0.0.0")))
(when (option-ref opts 'sigusr #f)
- (display "Listening for SIGUSR1\n" (current-error-port))
+ (format (current-error-port) (_ "Listening for SIGUSR1~%"))
;; NOTE this uses the main thread, and does therefore block HTTP requests
;; while reloading. However, it appears to not cause any race conditions.
(sigaction SIGUSR1
(lambda _
- (display "Received SIGUSR1, reloading calendars\n"
- (current-error-port))
+ (format (current-error-port) (_ "Received SIGUSR1, reloading calendars~%"))
((@ (vcomponent util instance) reload)))))
- (format #t "Starting server on ~a:~a~%I'm ~a, runing from ~a~%"
+ ;; Arguments are
+ ;; IP-address which we bind to
+ ;; Port which we listen to
+ ;; PID of this process
+ ;; PWD of this process
+ (format #t (_ "Starting server on ~a:~a~%I'm ~a, runing from ~a~%")
addr port
(getpid) (getcwd))
diff --git a/module/calp/entry-points/terminal.scm b/module/calp/entry-points/terminal.scm
index b0be318c..dd35b8f3 100644
--- a/module/calp/entry-points/terminal.scm
+++ b/module/calp/entry-points/terminal.scm
@@ -6,12 +6,13 @@
:use-module (datetime)
:use-module (vulgar)
:use-module (hnh util options)
+ :use-module (calp translation)
)
(define options
- '((date (value #t) (single-char #\d)
- (description "Which date to start on."))
- (help (single-char #\t) (description "Print this help."))
+ `((date (value #t) (single-char #\d)
+ (description ,(_ "Which date to start on.")))
+ (help (single-char #\t) (description ,(_ "Print this help.")))
))
(define (main args)
diff --git a/module/calp/entry-points/text.scm b/module/calp/entry-points/text.scm
index 0a5744b3..921afb80 100644
--- a/module/calp/entry-points/text.scm
+++ b/module/calp/entry-points/text.scm
@@ -4,16 +4,18 @@
:use-module (ice-9 getopt-long)
:use-module (hnh util io)
:use-module (hnh util options)
+ :use-module (calp translation)
+ :use-module (sxml simple)
)
(define options
- '((width (value #t) (single-char #\w)
- (description "Width of written text, defaults to 70 chars."))
+ `((width (value #t) (single-char #\w)
+ (description ,(_ "Width of written text, defaults to 70 chars.")))
(file (value #t) (single-char #\f)
- (description "Read from " (i "file") " instead of standard input."))
+ (description ,(xml->sxml (_ "<group>Read from <i>file</i> instead of standard input.</group>"))))
(help (single-char #\h)
- (description "Prints this help."))))
+ (description ,(_ "Prints this help.")))))
(define (main args)
(define opts (getopt-long args (getopt-opt options)))
@@ -24,6 +26,9 @@
(for-each (lambda (l) (display l) (newline))
(flow-text
- (with-input-from-port (open-input-port (option-ref opts 'file "-"))
+ (with-input-from-port (let ((fname (option-ref opts 'file "-")))
+ (if (string=? fname "-")
+ (current-input-port)
+ (open-input-file fname)))
(@ (ice-9 rdelim) read-string))
#:width (or (string->number (option-ref opts 'width "")) 70))))
diff --git a/module/calp/entry-points/tidsrapport.scm b/module/calp/entry-points/tidsrapport.scm
index 5ff43cf7..a05c3b78 100644
--- a/module/calp/entry-points/tidsrapport.scm
+++ b/module/calp/entry-points/tidsrapport.scm
@@ -42,6 +42,8 @@
:use-module (hnh util)
:use-module (hnh util options)
:use-module (ice-9 getopt-long)
+ :use-module (calp translation)
+ :use-module (sxml simple)
:use-module (datetime)
)
@@ -165,20 +167,20 @@ trailer
)
(define opt-spec
- '((pdf (value #t)
- (description "Input pdf fill"))
+ `((pdf (value #t)
+ (description ,(_ "Input pdf file")))
(output (single-char #\o) (value optional)
- (description "Output file"))
+ (description ,(_ "Output file")))
(data (value optional)
- (description "Static data to fill fields with")
+ (description ,(_ "Static data to fill fields with"))
)
(template (value optional)
- (description "Map between real field names and human readable names." (br)
- "If data is given, but not trans, then data is assumed to be in a correct format"))
+ (description ,(xml->sxml (_ "<group>Map between real field names and human readable names.<br/>
+If data is given, but not trans, then data is assumed to be in a correct format</group>"))))
(search (value #t)
(description
- "Search term for dynamic filling. Supports basic globbing"))))
+ ,(_ "Search term for dynamic filling. Supports basic globbing")))))
(define (parse-search str)
(cond [(string-match "\\{(.*)\\}" str)
@@ -204,7 +206,7 @@ trailer
(define template
(call-with-input-file
(or (option-ref opts 'template #f)
- (error "Template required"))
+ (error (_ "Template required")))
read))
(define prepared-data
@@ -232,9 +234,9 @@ trailer
(define days
(let ((days (assoc-ref group 'days)))
(cond ((not (list? days))
- (error "Needs list, not pair"))
+ (error (_ "Needs list, not pair")))
((null? days)
- (error "Need more days"))
+ (error (_ "Need more days")))
((and (list? (car days)) (eqv? '- (caar days)))
(map (lambda (s) (string-append prefix (->string s)))
(iota (1+ (- (list-ref (car days) 2)
@@ -250,7 +252,7 @@ trailer
,@(build-alist work-hours days)
(,sum ,(apply + work-hours))))
(or (assoc-ref template 'groups)
- (error "Groups required in template"))
+ (error (_ "Groups required in template")))
search)))
(define report
diff --git a/module/calp/html/caltable.scm b/module/calp/html/caltable.scm
index dd2d4b03..77580844 100644
--- a/module/calp/html/caltable.scm
+++ b/module/calp/html/caltable.scm
@@ -1,4 +1,5 @@
(define-module (calp html caltable)
+
:use-module (hnh util)
:use-module (calp html util)
:use-module (datetime)
@@ -35,6 +36,7 @@
;; making the text red for all holidays, or creating a yellow background
;; for events from a specific source.
(time (@ (datetime ,(date->string date "~Y-~m-~d")))
+ ;; TODO should this field be translated?
,(day date)))))
(define month-start (start-of-month start-date))
@@ -49,11 +51,13 @@
;; top row, names of week days
,@(map (lambda (d) `(div (@ (class "column-head"))
+ ;; TODO this SHOULD be translated
,(string-titlecase (week-day-name d 2))))
(weekday-list))
;; left columun, week numbers
,@(map (lambda (v) `(div (@ (class "row-head")) ,v))
+ ;; TODO translate this
(map week-number
(stream->list
(stream-take-while (lambda (s) (date<= s post-end))
diff --git a/module/calp/html/components.scm b/module/calp/html/components.scm
index 77a2a520..6642b1fe 100644
--- a/module/calp/html/components.scm
+++ b/module/calp/html/components.scm
@@ -2,6 +2,7 @@
:use-module (hnh util)
:use-module (ice-9 curried-definitions)
:use-module (ice-9 match)
+ :use-module (calp translation)
:export (xhtml-doc)
)
@@ -58,7 +59,7 @@
rest: args)
(when (and onclick href)
(scm-error 'wrong-type-arg "btn"
- "href and onclick are mutually exclusive. href = ~s, onclick = ~s."
+ (_ "href and onclick are mutually exclusive. href = ~s, onclick = ~s.")
(list href onclick)
#f))
diff --git a/module/calp/html/config.scm b/module/calp/html/config.scm
index 6bd1e0ec..08a4b2e8 100644
--- a/module/calp/html/config.scm
+++ b/module/calp/html/config.scm
@@ -1,11 +1,12 @@
(define-module (calp html config)
:use-module (hnh util)
:use-module (calp util config)
+ :use-module (calp translation)
)
(define-public debug (make-parameter #f))
(define-config debug #f
- description: "Places the generated thingy in debug mode"
+ description: (_ "Places the generated thingy in debug mode")
post: debug)
@@ -13,6 +14,6 @@
;;; but this works for the time being.
(define-public edit-mode (make-parameter #t))
(define-config edit-mode #t
- description: "Makes the document editable"
+ description: (_ "Makes the document editable")
post: edit-mode)
diff --git a/module/calp/html/util.scm b/module/calp/html/util.scm
index 54c92e92..affaf5d2 100644
--- a/module/calp/html/util.scm
+++ b/module/calp/html/util.scm
@@ -1,5 +1,6 @@
(define-module (calp html util)
- :use-module (hnh util))
+ :use-module (hnh util)
+ :use-module (calp translation))
(define-public (date-link date)
@@ -31,6 +32,6 @@
#xFF))
"#000000" "#FFFFFF")))
(lambda args
- (format (current-error-port) "Error calculating foreground color?~%~s~%" args)
+ (format (current-error-port) (_ "Error calculating foreground color?~%~s~%") args)
"#FF0000"
)))
diff --git a/module/calp/html/vcomponent.scm b/module/calp/html/vcomponent.scm
index c832ea93..5c92e1e7 100644
--- a/module/calp/html/vcomponent.scm
+++ b/module/calp/html/vcomponent.scm
@@ -24,6 +24,7 @@
:use-module (calp util config)
:use-module ((base64) :select (base64encode))
:use-module (ice-9 format)
+ :use-module (calp translation)
)
(define-config summary-filter (lambda (_ a) a)
@@ -68,10 +69,13 @@
"unknown")))))
(time ,(let ((dt (prop event 'DTSTART)))
(if (datetime? dt)
- (datetime->string dt "~Y-~m-~d ~H:~M")
- (date->string dt "~Y-~m-~d" ))))
+ ;; Compact event list date + time
+ (datetime->string dt (_ "~Y-~m-~d ~H:~M"))
+ ;; Compact event list date only
+ (date->string dt (_ "~Y-~m-~d") ))))
(a (@ (href ,(date->string (as-date (prop event 'DTSTART)) "/week/~Y-~m-~d.html")))
- "View 📅")
+ ;; Button for viewing calendar, accompanied by a calendar icon
+ ,(_ "View") " 📅")
(span ,(prop event 'SUMMARY)))))
(cons
(calendar-styles calendars)
@@ -109,6 +113,7 @@
(data-property "summary"))
,(prop ev 'SUMMARY))))
(div
+ ;; TODO localize this?
,(call-with-values (lambda () (fmt-time-span ev))
(case-lambda [(start)
`(div (time (@ (class "dtstart")
@@ -141,7 +146,7 @@
(div (@ (class "fields"))
,(when (and=> (prop ev 'LOCATION) (negate string-null?))
- `(div (b "Plats: ")
+ `(div (b ,(_ "Location: "))
(div (@ (class "location") (data-property "location"))
,(string-map (lambda (c) (if (char=? c #\,) #\newline c))
(prop ev 'LOCATION)))))
@@ -218,8 +223,10 @@
,@(format-recurrence-rule ev)))
,(when (prop ev 'LAST-MODIFIED)
- `(div (@ (class "last-modified")) "Senast ändrad "
- ,(datetime->string (prop ev 'LAST-MODIFIED) "~1 ~H:~M"))))
+ `(div (@ (class "last-modified")) ,(_ "Last modified") " "
+ ,(datetime->string (prop ev 'LAST-MODIFIED)
+ ;; Last modified datetime
+ (_ "~1 ~H:~M")))))
))))
@@ -229,7 +236,9 @@
(define-public (fmt-day day)
(let* (((date . events) day))
`(section (@ (class "text-day"))
- (header (h2 ,(let ((s (date->string date "~Y-~m-~d")))
+ (header (h2 ,(let ((s (date->string date
+ ;; Header for sidebar day
+ (_ "~Y-~m-~d"))))
`(a (@ (href "#" ,s)
(class "hidelink")) ,s))))
,@(stream->list
@@ -314,12 +323,13 @@
;; TODO possibly unused?
(define (repeat-info event)
`(div (@ (class "eventtext"))
- (h2 "Upprepningar")
+ (h2 ,(_ "Recurrences"))
(table (@ (class "recur-components"))
,@((@@ (vcomponent recurrence internal) map-fields)
(lambda (key value)
`(tr (@ (class ,key)) (th ,key)
(td
+ ;; TODO Should these date string be translated?
,(case key
((wkst) (week-day-name value))
((until) (if (date? value)
@@ -364,6 +374,7 @@
`(select (@ ,@args)
(option "-")
,@(map (lambda (x) `(option (@ (value ,(car x))) ,(cadr x)))
+ ;; TODO translate
'((MO "Monday")
(TU "Tuesday")
(WE "Wednesday")
@@ -383,7 +394,8 @@
(div (@ (class " eventtext edit-tab "))
(form (@ (class "edit-form"))
(select (@ (class "calendar-selection"))
- (option "- Choose a Calendar -")
+ ;; NOTE flytta "muffarna" utanför
+ (option ,(_ "- Choose a Calendar -"))
,@(let ((dflt (get-config 'default-calendar)))
(map (lambda (calendar)
(define name (prop calendar 'NAME))
@@ -393,7 +405,7 @@
,name))
calendars)))
(h3 (input (@ (type "text")
- (placeholder "Sammanfattning")
+ (placeholder ,(_ "Summary"))
(name "summary") (required)
(data-property "summary")
; (value ,(prop ev 'SUMMARY))
@@ -402,24 +414,24 @@
(div (@ (class "timeinput"))
,@(with-label
- "Starttid"
+ (_ "Start time")
'(date-time-input (@ (name "dtstart")
(data-property "dtstart")
)))
,@(with-label
- "Sluttid"
+ (_ "End time")
'(date-time-input (@ (name "dtend")
(data-property "dtend"))))
(div (@ (class "checkboxes"))
,@(with-label
- "Heldag?"
+ (_ "Whole day?")
`(input (@ (type "checkbox")
(name "wholeday")
)))
,@(with-label
- "Upprepande?"
+ (_ "Recurring?")
`(input (@ (type "checkbox")
(name "has_repeats")
))))
@@ -427,8 +439,8 @@
)
,@(with-label
- "Plats"
- `(input (@ (placeholder "Plats")
+ (_ "Location")
+ `(input (@ (placeholder ,(_ "Location"))
(name "location")
(type "text")
(data-property "location")
@@ -436,20 +448,20 @@
)))
,@(with-label
- "Beskrivning"
- `(textarea (@ (placeholder "Beskrivning")
+ (_ "Description")
+ `(textarea (@ (placeholder ,(_ "Description"))
(data-property "description")
(name "description"))
; ,(prop ev 'DESCRIPTION)
))
,@(with-label
- "Kategorier"
+ (_ "Categories")
`(input-list
(@ (name "categories")
(data-property "categories"))
(input (@ (type "text")
- (placeholder "Kattegori")))))
+ (placeholder (_ "Category"))))))
;; TODO This should be a "list" where any field can be edited
;; directly. Major thing holding us back currently is that
@@ -481,6 +493,7 @@
"↺")
(span (@ (class "summary")
(data-property "summary")))))
+ ;; TODO should't the time tags contain something?
(div (div (time (@ (class "dtstart")
(data-property "dtstart")
(data-fmt "~L~H:~M")
@@ -497,7 +510,7 @@
; "20:56"
))
(div (@ (class "fields"))
- (div (b "Plats: ")
+ (div (b ,("Location: "))
(div (@ (class "location")
(data-property "location"))
; "Alsättersgatan 13"
@@ -519,7 +532,7 @@
;; "varje vecka"
;; ".")
(div (@ (class "last-modified"))
- "Senast ändrad -"
+ ,(_ "Last Modified") " -"
; "2021-09-29 19:56"
))))))
@@ -527,21 +540,21 @@
`(template
(@ (id "vevent-edit-rrule"))
(div (@ (class "eventtext"))
- (h2 "Upprepningar")
+ (h2 ,(_ "Recurrences"))
(dl
- (dt "Frequency")
+ (dt ,(_ "Frequency"))
(dd (select (@ (name "freq"))
(option "-")
,@(map (lambda (x) `(option (@ (value ,x)) ,(string-titlecase (symbol->string x))))
'(SECONDLY MINUTELY HOURLY DAILY WEEKLY MONTHLY YEARLY))))
- (dt "Until")
+ (dt ,(_ "Until"))
(dd (date-time-input (@ (name "until"))))
- (dt "Conut")
+ (dt ,(_ "Conut"))
(dd (input (@ (type "number") (name "count") (min 0))))
- (dt "Interval")
+ (dt ,(_ "Interval"))
(dd (input (@ (type "number") (name "interval") ; min and max depend on FREQ
)))
@@ -555,14 +568,14 @@
(dd (input-list (@ (name ,name))
(input (@ (type "number")
(min ,min) (max ,max)))))))
- '((bysecond "By Second" 0 60)
- (byminute "By Minute" 0 59)
- (byhour "By Hour" 0 23)
- (bymonthday "By Month Day" -31 31) ; except 0
- (byyearday "By Year Day" -366 366) ; except 0
- (byweekno "By Week Number" -53 53) ; except 0
- (bymonth "By Month" 1 12)
- (bysetpos "By Set Position" -366 366) ; except 0
+ '((bysecond ,(_ "By Second") 0 60)
+ (byminute ,(_ "By Minute") 0 59)
+ (byhour ,(_ "By Hour") 0 23)
+ (bymonthday ,(_ "By Month Day") -31 31) ; except 0
+ (byyearday ,(_ "By Year Day") -366 366) ; except 0
+ (byweekno ,(_ "By Week Number") -53 53) ; except 0
+ (bymonth ,(_ "By Month") 1 12)
+ (bysetpos ,(_ "By Set Position") -366 366) ; except 0
)))
;; (dt "By Week Day")
@@ -573,7 +586,7 @@
;; ,(week-day-select '())
;; ))
- (dt "Weekstart")
+ (dt ,(_ "Weekstart"))
(dd ,(week-day-select '((name "wkst")))))))
)
@@ -588,32 +601,36 @@
(nav (@ (class "popup-control"))
(button (@ (class "close-button")
- (title "Stäng")
+ ;; Close this popup
+ (title ,(_ "Close"))
(aria-label "Close"))
"×")
(button (@ (class "maximize-button")
- (title "Fullskärm")
+ ;; Make this popup occupy the entire screen
+ (title ,(_ "Fullscreen"))
;; (aria-label "")
)
"🗖")
(button (@ (class "remove-button")
- (title "Ta Bort"))
+ ;; Remove/Trash the event this popup represent
+ ;; Think garbage can
+ (title ,(_ "Remove")))
"🗑"))
(tab-group (@ (class "window-body"))
(vevent-description
- (@ (data-label "📅") (data-title "Översikt")
+ (@ (data-label "📅") (data-title ,(_ "Overview"))
(class "vevent")))
(vevent-edit
- (@ (data-label "🖊") (data-title "Redigera")))
+ (@ (data-label "🖊") (data-title ,(_ "Edit"))))
;; (vevent-edit-rrule
;; (@ (data-label "↺") (data-title "Upprepningar")))
(vevent-changelog
- (@ (data-label "📒") (date-title "Changelog")))
+ (@ (data-label "📒") (date-title ,(_ "Changelog"))))
,@(when (debug)
'((vevent-dl
- (@ (data-label "🐸") (data-title "Debug")))))))))
+ (@ (data-label "🐸") (data-title ,(_ "Debug"))))))))))
diff --git a/module/calp/html/view/calendar.scm b/module/calp/html/view/calendar.scm
index cfbb1865..d4ad2977 100644
--- a/module/calp/html/view/calendar.scm
+++ b/module/calp/html/view/calendar.scm
@@ -29,6 +29,7 @@
:use-module ((base64) :select (base64encode))
:use-module (ice-9 format)
+ :use-module (calp translation)
)
@@ -74,10 +75,10 @@
,display)))
(unless next-start
- (scm-error 'misc-error "html-generate" "Next-start needs to be a procedure" #f #f))
+ (scm-error 'misc-error "html-generate" (_ "Next-start needs to be a procedure") #f #f))
(unless prev-start
- (scm-error 'misc-error "html-generate" "Prev-start needs to be a procedure" #f #f))
+ (scm-error 'misc-error "html-generate" (_ "Prev-start needs to be a procedure") #f #f))
(xhtml-doc
(@ (lang sv))
@@ -88,9 +89,11 @@
(meta (@ (name viewport)
(content "width=device-width, initial-scale=0.5")))
(meta (@ (name description)
- (content "Calendar for the dates between "
- ,(date->string start-date) " and "
- ,(date->string end-date))))
+ (content ,(format #f (_ "Calendar for the dates between ~a and ~a")
+ ;; start date metainfo
+ (date->string start-date (_ "~Y-~m-~d"))
+ ;; end date metainfo
+ (date->string end-date (_ "~Y-~m-~d"))))))
;; NOTE this is only for the time actually part of this calendar.
;; overflowing times from pre-start and post-end is currently ignored here.
(meta (@ (name start-time)
@@ -151,10 +154,12 @@ window.default_calendar='~a';"
;; Page footer
(footer
(@ (style "grid-area: footer"))
- (span "Page generated " ,(date->string (current-date)))
- (span "Current time " (current-time (@ (interval 1))))
+ (span ,(_ "Page generated ")
+ ;; Generation data
+ ,(date->string (current-date) (_ "~Y-~m-~d")))
+ (span ,(_ "Current time ") (current-time (@ (interval 1))))
(span (a (@ (href ,(repo-url)))
- "Source Code")))
+ ,(_ "Source Code"))))
;; Small calendar and navigation
(nav (@ (class "calnav") (style "grid-area: nav"))
@@ -164,10 +169,12 @@ window.default_calendar='~a';"
(start-of-week start-date)
start-date)
"/week/~1.html")
- "veckovy")
+ ;; Button to view week
+ (_ "Week"))
,(btn href: (date->string (set (day start-date) 1) "/month/~1.html")
- "månadsvy")
+ ;; button to view month
+ (_ "Month"))
(today-button
(a (@ (class "btn")
@@ -176,7 +183,8 @@ window.default_calendar='~a';"
[(month) "view=month"]
[(week) "view=week"]
[else ""]))))
- "idag")))
+ ;; Button to go to today
+ ,(_ "Today"))))
(div (@ (id "jump-to"))
;; Firefox's accessability complain about each date
@@ -196,9 +204,11 @@ window.default_calendar='~a';"
,(btn "➔"))))
(details (@ (open) (style "grid-area: cal"))
- (summary "Month overview")
+ (summary ,(_ "Month overview"))
(div (@ (class "smallcall-head"))
- ,(string-titlecase (date->string start-date "~B ~Y")))
+ ,(string-titlecase (date->string start-date
+ ;; Header of small calendar
+ (_ "~B ~Y"))))
;; NOTE it might be a good idea to put the navigation buttons
;; earlier in the DOM-tree/tag order. At least Vimium's
;; @key{[[} keybind sometimes finds parts of events instead.
@@ -223,17 +233,17 @@ window.default_calendar='~a';"
(action "/search/text"))
(input (@ (type "text")
(name "q")
- (placeholder "Sök")))
+ ;; Search placeholder
+ (placeholder ,(_ "Search"))))
(input (@ (type "submit")
(value ">"))))
,(when (or (debug) (edit-mode))
`(details (@ (class "sliders"))
- (summary "Option sliders")
-
+ (summary ,(_ "Option sliders"))
,@(when (edit-mode)
- `((label "Event blankspace")
+ `((label ,(_ "Event blankspace"))
,(slider-input
variable: "editmode"
min: 0
@@ -242,7 +252,7 @@ window.default_calendar='~a';"
value: 1)))
,@(when (debug)
- `((label "Fontsize")
+ `((label ,(_ "Fontsize"))
,(slider-input
unit: "pt"
min: 1
@@ -253,7 +263,7 @@ window.default_calendar='~a';"
;; List of calendars
(details (@ (class "calendarlist"))
- (summary "Calendar list")
+ (summary ,(_ "Calendar list"))
(ul ,@(map
(lambda (calendar)
`(li (@ (data-calendar ,(base64encode (prop calendar 'NAME))))
@@ -279,7 +289,7 @@ window.default_calendar='~a';"
;; Events which started before our start point,
;; but "spill" into our time span.
(section (@ (class "text-day"))
- (header (h2 "Tidigare"))
+ (header (h2 ,(_ "Earlier")))
;; TODO this group gets styles applied incorrectly.
;; Figure out way to merge it with the below call.
,@(stream->list
@@ -287,8 +297,7 @@ window.default_calendar='~a';"
(lambda (ev)
(fmt-single-event
ev `((id ,(html-id ev))
- (data-calendar ,(base64encode (or (prop (parent ev) 'NAME)
- "unknown"))))))
+ (data-calendar ,(base64encode (or (prop (parent ev) 'NAME) "unknown"))))))
(stream-take-while
(compose (cut date/-time<? <> start-date)
(extract 'DTSTART))
diff --git a/module/calp/html/view/calendar/week.scm b/module/calp/html/view/calendar/week.scm
index 38e7501b..16337102 100644
--- a/module/calp/html/view/calendar/week.scm
+++ b/module/calp/html/view/calendar/week.scm
@@ -17,6 +17,7 @@
:select (make-block output-uid) )
;; :use-module ((calp html components)
;; :select ())
+ :use-module (calp translation)
:use-module ((vcomponent util group)
:select (group-stream get-groups-between))
:use-module (ice-9 format)
@@ -31,7 +32,9 @@
(div (@ (class "days"))
;; Top left area
(div (@ (class "week-indicator"))
- (span (@ (style "font-size: 50%")) "v.") ; figure out if we want this...
+ (span (@ (style "font-size: 50%"))
+ ;; Week number prefix
+ ,(_ "v."))
,@(->> (week-number start-date)
number->string string->list
(map (lambda (c) `(span ,(string c))))))
@@ -44,8 +47,10 @@
,@(map (lambda (day-date)
`(div (@ (class "meta"))
(span (@ (class "daydate"))
- ,(date->string day-date "~Y-~m-~d"))
+ ;; Week view header format
+ ,(date->string day-date (_ "~Y-~m-~d")))
(span (@ (class "dayname"))
+ ;; TODO translation here?
,(string-titlecase (date->string day-date "~a")))))
range)
,@(stream->list
diff --git a/module/calp/html/view/search.scm b/module/calp/html/view/search.scm
index 9b03151b..08436bc5 100644
--- a/module/calp/html/view/search.scm
+++ b/module/calp/html/view/search.scm
@@ -8,6 +8,7 @@
:select (xhtml-doc include-css))
:use-module ((calp html vcomponent)
:select (compact-event-list))
+ :use-module (calp translation)
)
;; Display the result of a search term, but doesn't do any searching
@@ -24,25 +25,25 @@
errors has-query? search-term search-result page paginator)
(xhtml-doc
(@ (lang sv))
- (head (title "Search results")
+ (head (title ,(_ "Search results"))
,(include-css "/static/style.css"))
(body
- (a (@ (href ("/today"))) "Till Idag")
- (h2 "Search term")
+ (a (@ (href ("/today"))) ,(_ "Show today"))
+ (h2 ,(_ "Search term"))
(form
(pre (textarea (@ (name "q") (rows 5) (spellcheck false)
(style "width:100%"))
,(when has-query?
(with-output-to-string
(lambda () (pretty-print search-term))))))
- (label (@ (for "onlyfuture")) "limit to future occurences")
+ (label (@ (for "onlyfuture")) ,(_ "limit to future occurences"))
(input (@ (name "onlyfuture") (id "onlyfuture") (type checkbox)))
(input (@ (type submit))))
,@(if errors
- `((h2 "Error searching")
+ `((h2 ,(_ "Error searching"))
(div (@ (class "error"))
(pre ,errors)))
- `((h2 "Result (page " ,page ")")
+ `((h2 ,(format #f (_ "Result (page ~a)") page))
(ul ,@(compact-event-list search-result))
(div (@ (class "paginator"))
,@(paginator->list
diff --git a/module/calp/main.scm b/module/calp/main.scm
index 7477e2e8..e5388ae0 100644
--- a/module/calp/main.scm
+++ b/module/calp/main.scm
@@ -24,29 +24,31 @@
:use-module (statprof)
:use-module (calp repl)
+ :use-module (sxml simple)
:use-module ((xdg basedir) :prefix xdg-)
+ :use-module (calp translation)
+
)
(define options
`((statprof (value display-style)
- (description "Run the program within Guile's built in statical "
- "profiler. Display style is one of "
- (b "flat") " or " (b "tree") "."))
+ (description ,(xml->sxml (_ "<group>Run the program within Guile's built in statical
+profiler. Display style is one of <b>flat</b> or <b>tree</b>.</group>"))))
(repl (value address)
(description
- "Start a Guile repl which can be connected to, defaults to the unix socket "
- (i "/run/user/${UID}/calp-${PID}") ", but it can be bound to any unix or "
- "TCP socket. ((@ (vcomponent util instance) global-event-object)) "
- "should contain all events."
- (br)
- (b "Should NOT be used in production.")))
+ ,(xml->sxml (_ "<group>Start a Guile repl which can be connected to, defaults to the
+unix socket <i>/run/user/${UID}/calp-${PID}</i>, but it can be bound to any
+unix or TCP socket. ((@ (vcomponent util instance) global-event-object)) should
+contain all events.
+<br/>
+<b>Should NOT be used in production.</b></group>"))))
(config (value #t)
(description
- "Path to alterantive configuration file to load instead of the default one. "))
+ ,(_ "Path to alterantive configuration file to load instead of the default one.")))
;; Techical note:
;; Guile's getopt doesn't support repeating keys. Thereby the small jank,
@@ -54,57 +56,54 @@
(option (single-char #\o)
(value #t)
(description
- "Set configuration options, on the form "
- (i "key") "=" (i "value")
- " as if they were set in the config file. These options have "
- "priority over those from the file. "
- "Can " (i "not") " be given with an equal after --option."
- (br) "Can be given multiple times."))
+ ,(xml->sxml (_ "<group>Set configuration options, on the form <i>key</i>=<i>value</i>
+as if they were set in the config file. These options have priority over those
+from the file. Can <i>not</i> be given with an equal after --option. <br/>Can
+be given multiple times.</group>"))))
(version (single-char #\v)
- (description "Display version, which is " ,(@ (calp) version) " btw."))
+ (description ,(format #f (_ "Display version, which is ~a btw.")
+ (@ (calp) version))))
(update-zoneinfo)
(help (single-char #\h)
- (description "Print this help"))
+ (description ,(_ "Print this help")))
- (printconf (description "Print known configuration variables."
- (br) (b "NOTE") ": "
- "Only those configuration variables which are loaded "
- "will be shown, more might be available"))))
+ (printconf (description ,(xml->sxml (_ "<group>Print known configuration variables.
+<br/><b>NOTE</b>:
+Only those configuration variables which are loaded will be shown, more might be
+available</group>"))))))
(define module-help
- '(*TOP* (br)
- (center (b "Calp")) (br) (br)
- "Usage: " (b "calp") " [ " (i flags) " ] " (i mode) " [ " (i "mode flags") " ]" (br)
-
- (hr)
- (center (b "Modes")) (br) (br)
-
- (p (b "html") " reads calendar files from disk, and writes them to static HTML files.")
-
- (p (b "terminal") " loads the calendars, and startrs an interactive terminal interface.")
-
- "[UNTESTED]" (br)
- (p (b "import") "s an calendar object into the database.")
-
- (p (b "text") " formats and justifies what it's given on standard input, "
- "and writes it to standard output. Similar to this text.")
-
- (p (b "ical") " loads the calendar database, and imideately "
- "reserializes it back into ICAL format. "
- "Useful for merging calendars.")
-
- (p (b "benchmark") " " (i "module") (br)
- "Runs the procedure 'run-benchmark' from the module (calp benchmark " (i "module") ").")
-
- (p (b "server") " starts an HTTP server which dynamicly loads and displays event. The "
- (i "/month/{date}.html") " & " (i "/week/{date}.html") " runs the same output code as "
- (b "html") ". While the " (i "/calendar/{uid}.ics") " uses the same code as " (b "ical") ".")
-
- (hr) (br)
- (center (b "Flags")) (br)))
+ (xml->sxml
+ (string-append
+ "<group><br/>
+<center><b>" "Calp" "</b></center>
+<br/><br/>
+" (_ "Usage: <b>calp</b> [ <i>flags</i> ] <i>mode</i> [ <i>mode flags</i> ]") "<br/>
+<hr/>"
+;; Header for following list of modes of operation
+ "<center><b>" (_ "Modes") "</b></center>
+<br/><br/>"
+ (_ "<p><b>html</b> reads calendar files from disk, and writes them to static HTML files.</p>")
+ (_ "<p><b>terminal</b> loads the calendars, and starts an interactive terminal interface.</p>")
+ (_ "[UNTESTED]<br/><p><b>import</b>s a calendar object into the database.</p>")
+ (_ "<p><b>text</b> formats and justifies what it's given on standard input,
+and writes it to standard output. Similar to this text.</p>")
+ (_ "<p><b>ical</b> loads the calendar database, and immediately
+re-serializes it back into iCAL format. Useful for merging calendars.</p>")
+ (_ "<p><b>benchmark</b> <i>module</i><br/>Runs the procedure 'run-benchmark'
+from the module (calp benchmark <i>module</i>).</p>")
+ (_ "<p><b>server</b> starts an HTTP server which dynamically loads and
+displays events. The <i>/month/{date}.html</i> &amp; <i>/week/{date}.html</i> runs
+the same output code as <b>html</b>. While the <i>/calendar/{uid}.ics</i> uses
+the same code as <b>ical</b>.</p>")
+ "<hr/><br/>"
+ ;; Header for list of available flags.
+ ;; Actual list is auto generated elsewhere.
+ "<center><b>" (_ "Flags") "</b></center>
+<br/></group>")))
(define (ornull a b)
(if (null? a)
@@ -122,7 +121,7 @@
altconfig
(scm-error 'misc-error
"wrapped-main"
- "Configuration file ~a missing"
+ (_ "Configuration file ~a missing")
(list altconfig)
#f))]
;; altconfig could be placed in the list below. But I want to raise an error
@@ -169,7 +168,10 @@
))
(lambda args
(format (current-error-port)
- "Failed loading config file ~a~%~s~%"
+ ;; Two arguments:
+ ;; Configuration file path,
+ ;; thrown error arguments
+ (_ "Failed loading config file ~a~%~s~%")
config-file
args
)))
@@ -210,14 +212,14 @@
(throw 'return))
(when (option-ref opts 'version #f)
- (format #t "Calp version ~a~%" (@ (calp) version))
+ (format #t (_ "Calp version ~a~%") (@ (calp) version))
(throw 'return))
(when (option-ref opts 'update-zoneinfo #f)
(let* ((locations (list "/usr/libexec/calp/tzget" (path-append (xdg-data-home) "tzget")))
(filename (or (find file-exists? locations)
(scm-error 'missing-helper "wrapped-main"
- "tzget not installed, please put it in one of ~a"
+ (_ "tzget not installed, please put it in one of ~a")
(list locations)
(list "tzget" locations))))
(pipe (open-input-pipe filename)))
@@ -253,7 +255,7 @@
((benchmark) (@ (calp entry-points benchmark) main))
(else => (lambda (s)
(format (current-error-port)
- "Unsupported mode of operation: ~a~%"
+ (_ "Unsupported mode of operation: ~a~%")
s)
(exit 1))))
ropt))
@@ -268,7 +270,7 @@
(define-public (main args)
- ((@ (calp util time) report-time!) "Program start")
+ ((@ (calp util time) report-time!) (_ "Program start"))
(with-throw-handler #t
(lambda ()
(dynamic-wind (lambda () 'noop)
diff --git a/module/calp/repl.scm b/module/calp/repl.scm
index 47c35a40..6f2c7c0a 100644
--- a/module/calp/repl.scm
+++ b/module/calp/repl.scm
@@ -7,12 +7,13 @@
:use-module (ice-9 regex)
:use-module ((calp util hooks) :select (shutdown-hook))
:use-module ((hnh util exceptions) :select (warning))
+ :use-module (calp translation)
)
(define-public (repl-start address)
(define lst (string->list address))
(format (current-error-port)
- "Starting REPL server at ~a~%" address)
+ (_ "Starting REPL server at ~a~%") address)
(spawn-server
(case (cond [(memv (car lst) '(#\. #\/)) 'UNIX]
[(string-match "(\\d{1,3}\\.){3}\\d{1,3}(:\\d+)?" address) 'IPv4]
@@ -22,17 +23,17 @@
[(UNIX)
(add-hook! shutdown-hook (lambda () (catch 'system-error (lambda () (delete-file address))
(lambda (err proc fmt args data)
- (warning (format #f "Failed to unlink ~a: ~?"
- address fmt args))
+ (warning (string-append (format #f (_ "Failed to unlink ~a") address)
+ (format #f ": ~?" fmt args)))
err))))
(make-unix-domain-server-socket path: address)]
[(IPv4) (apply (case-lambda
- [() (error "Empty address?")]
+ [() (error (_ "Empty address?"))]
[(address) (make-tcp-server-socket host: address)]
[(address port) (make-tcp-server-socket host: address port: port)])
(string-split address #\:))]
;; currently impossible
- [(IPv6) (error "How did you get here?")]))
+ [(IPv6) (error (_ "How did you get here?"))]))
;; TODO setup repl environment here
diff --git a/module/calp/server/routes.scm b/module/calp/server/routes.scm
index 88f641fb..d05451eb 100644
--- a/module/calp/server/routes.scm
+++ b/module/calp/server/routes.scm
@@ -33,7 +33,11 @@
:use-module (calp util config)
:use-module (calp html view calendar)
- :use-module ((calp html view search) :select (search-result-page)))
+ :use-module ((calp html view search) :select (search-result-page))
+
+ :use-module (calp translation)
+
+ )
@@ -49,8 +53,13 @@
;; start with /static.
(define (directory-table prefix dir)
`(table (@ (class "directory-table"))
- (thead
- (tr (th "") (th "Name") (th "Perm") (th "Size")))
+ (thead
+ (tr (th "")
+ (th ,(_ "Name"))
+ ;; File permissions, should be about as long as three digits
+ (th ,(_ "Perm"))
+ ;; File size
+ (th ,(_ "Size"))))
(tbody
(tr (td "↩️") (td (@ (colspan 3))
(a (@ (href ,(-> (path-split dir)
@@ -80,7 +89,7 @@
(scm-error
'misc-error
"directory-table"
- "Scandir argument invalid or not directory: ~s"
+ (_ "Scandir argument invalid or not directory: ~s")
(list dir) '())))))))
@@ -122,7 +131,7 @@
(GET "/" ()
(return '((content-type text/html))
(sxml->html-string
- '(body (a (@ (href "/today")) "Gå till idag")
+ '(body (a (@ (href "/today")) ,(_ "Go to Today"))
(script "window.onload = function() {
document.getElementsByTagName('a')[0].click();}")))))
@@ -175,7 +184,7 @@
(POST "/remove" (uid)
(unless uid
(return (build-response code: 400)
- "uid required"))
+ (_ "uid required")))
(aif (get-event-by-uid global-event-object uid)
(begin
@@ -187,10 +196,10 @@
(set! (param (prop* it 'X-HNH-REMOVED) 'VALUE) "BOOLEAN")
(unless ((@ (vcomponent formats vdir save-delete) save-event) it)
(return (build-response code: 500)
- "Saving event to disk failed."))
+ (_ "Saving event to disk failed.")))
(return (build-response code: 204)))
(return (build-response code: 400)
- (format #f "No event with UID '~a'" uid))))
+ (format #f (_ "No event with UID '~a'") uid))))
;; TODO this fails when dtstart is <date>.
;; @var{cal} should be the name of the calendar encoded in base64.
@@ -198,7 +207,7 @@
(unless (and cal data)
(return (build-response code: 400)
- "Both 'cal' and 'data' required\r\n"))
+ (string-append (_ "Both 'cal' and 'data' required") "\r\n")))
;; NOTE that this leaks which calendar exists,
@@ -211,7 +220,8 @@
(unless calendar
(return (build-response code: 400)
- (format #f "No calendar with name [~a]\r\n" calendar-name)))
+ (format #f "~@?\r\n" (_ "No calendar with name [~a]")
+ calendar-name)))
;; Expected form of data (but in XML) is:
;; @example
@@ -240,11 +250,13 @@
#f))
(lambda (err port . args)
(return (build-response code: 400)
- (format #f "XML parse error ~{~a~}\r\n" args)))))))
+ (format #f "~a ~{~a~}\r\n"
+ (_ "XML parse error")
+ args)))))))
(unless (eq? 'VEVENT (type event))
(return (build-response code: 400)
- "Object not a VEVENT\r\n"))
+ (string-append (_ "Object not a VEVENT") "\r\n")))
;; NOTE add-event uses the given UID if one is given,
;; but generates its own if not. It might be a good idea
@@ -320,7 +332,7 @@
;; and "program parent" into different fields.
(lambda () (sxml->xml ((@ (vcomponent formats xcal output) vcomponent->sxcal) it)))))
(return (build-response code: 404)
- (format #f "No component with UID=~a found." uid))))
+ (format #f (_ "No component with UID=~a found.") uid))))
(GET "/calendar/:uid{.*}.ics" (uid)
(aif (get-event-by-uid global-event-object uid)
@@ -329,7 +341,7 @@
(lambda () (print-components-with-fake-parent
(list it)))))
(return (build-response code: 404)
- (format #f "No component with UID=~a found." uid))))
+ (format #f (_ "No component with UID=~a found.") uid))))
(GET "/search/text" (q)
(return (build-response
diff --git a/module/calp/server/server.scm b/module/calp/server/server.scm
index fc185033..b9d5c6d3 100644
--- a/module/calp/server/server.scm
+++ b/module/calp/server/server.scm
@@ -1,4 +1,5 @@
(define-module (calp server server)
+
:use-module (hnh util)
:use-module (web server)
:use-module ((calp server routes) :select (make-make-routes))
diff --git a/module/calp/terminal.scm b/module/calp/terminal.scm
index c83e76ce..d91dc584 100644
--- a/module/calp/terminal.scm
+++ b/module/calp/terminal.scm
@@ -26,6 +26,7 @@
#:use-module (oop goops)
#:use-module (oop goops describe)
+ #:use-module (calp translation)
#:autoload (vcomponent util instance) (global-event-object)
@@ -74,7 +75,7 @@
" │ "
(if (prop ev 'LOCATION) "" "\x1b[1;30m")
(trim-to-width
- (or (prop ev 'LOCATION) "INGEN LOKAL") location-width)
+ (or (prop ev 'LOCATION) (_ "NO LOCATION")) location-width)
STR-RESET
"\n")))
events
@@ -125,7 +126,8 @@
(cls)
- (display "== Day View ==\n")
+ (display (_ "== Day View =="))
+ (newline)
(display-calendar-header! (current-page this))
@@ -138,22 +140,35 @@
;; display highlighted event
(unless (null? events)
(let ((ev (list-ref events (active-element this))))
- (format #t "~a~%~% ~a~%~%~a\x1b[1mStart:\x1b[m ~a \x1b[1mSlut:\x1b[m ~a~%~%~a~%"
- (prop ev '-X-HNH-FILENAME)
- (prop ev 'SUMMARY)
- (or (and=> (prop ev 'LOCATION)
- (cut string-append "\x1b[1mPlats:\x1b[m " <> "\n")) "")
- ;; NOTE RFC 5545 says that DTSTART and DTEND MUST
- ;; have the same type. However we believe that is
- ;; another story.
+ (format #t "~a" (prop ev '-X-HNH-FILENAME))
+ (format #t "~%~%")
+ (format #t " ~a" (prop ev 'SUMMARY))
+ (format #t "~%~%")
+ (awhen (prop ev 'LOCATION)
+ (format #t
+ "\x1b[1m~a:\x1b[m ~a~%"
+ (_ "Location")
+ it))
+ ;; NOTE RFC 5545 says that DTSTART and DTEND MUST
+ ;; have the same type. However we believe that is
+ ;; another story.
+ (format #t "\x1b[1m~a:\x1b[m ~a "
+ (_ "Start")
(let ((start (prop ev 'DTSTART)))
(if (datetime? start)
- (datetime->string (prop ev 'DTSTART) "~Y-~m-~d ~H:~M:~S")
- (date->string start)))
- (let ((end (prop ev 'DTEND)))
- (if (datetime? end)
- (datetime->string (prop ev 'DTEND) "~Y-~m-~d ~H:~M:~S")
- (date->string end)))
+ (datetime->string (prop ev 'DTSTART)
+ ;; Event start date-time terminal view
+ (_ "~Y-~m-~d ~H:~M:~S"))
+ (date->string start))))
+ (format #t "\x1b[1m~a:\x1b[m ~a~%~%"
+ (_ "End")
+ (let ((start (prop ev 'DTSTART)))
+ (if (datetime? start)
+ (datetime->string (prop ev 'DTSTART)
+ ;; Event end date-time terminal view
+ (_ "~Y-~m-~d ~H:~M:~S"))
+ (date->string start))))
+ (format #t "~a~%"
(unlines (take-to (flow-text (or (prop ev 'DESCRIPTION) "")
#:width (min 70 width))
(- height 8 5 (length events) 5)))))))
@@ -194,14 +209,14 @@
(active-element this) 0))
((#\/) (set-cursor-pos 0 (1- height))
- (let ((search-term (get-line "quick search: ")))
+ (let ((search-term (get-line (_ "quick search: "))))
`(push ,(search-view
(format #f "(regexp-exec (make-regexp \"~a\" regexp/icase) (prop event 'SUMMARY))"
search-term)
(get-event-set this)))))
((#\() (set-cursor-pos 0 (1- height))
- (let ((search-term (get-line "search: ")))
+ (let ((search-term (get-line (_ "search: "))))
`(push ,(search-view search-term (get-event-set this)))))
(else (next-method))))
@@ -247,7 +262,7 @@
(cls)
- (display "== Search View ==\n")
+ (display (_ "== Search View ==\n"))
;; display search term
(format #t "~y" (search-term this))
@@ -303,7 +318,7 @@
'DTSTART)))))
((#\h left) (set! (current-page this) = ((lambda (old) (max 0 (1- old))))))
((#\l right)
- (display "\n loading...\n")
+ (format #t "~% ~a~%" (_ "loading..."))
(set! (current-page this)
(next-page (slot-ref this 'search-result)
(current-page this))))
diff --git a/module/calp/translation.scm b/module/calp/translation.scm
new file mode 100644
index 00000000..c0392d95
--- /dev/null
+++ b/module/calp/translation.scm
@@ -0,0 +1,20 @@
+(define-module (calp translation)
+ :use-module (ice-9 i18n)
+ :use-module (ice-9 regex)
+ :use-module (ice-9 match)
+ :export (_ yes-no-check))
+
+(bindtextdomain "calp" "/home/hugo/code/calp/localization/")
+
+(define (_ . msg)
+ ;; NOTE this doesn't squeese repeated whitespace
+ (string-map (match-lambda
+ (#\newline #\space)
+ (c c))
+ (gettext (string-join msg) "calp")))
+
+(define* (yes-no-check string #:optional (locale %global-locale))
+ (cond ((string-match (locale-yes-regexp locale) string) 'yes)
+ ((string-match (locale-no-regexp locale) string) 'no)
+ (else #f)))
+
diff --git a/module/calp/util/config.scm b/module/calp/util/config.scm
index 4862bbda..3bc55d92 100644
--- a/module/calp/util/config.scm
+++ b/module/calp/util/config.scm
@@ -9,6 +9,7 @@
:use-module (srfi srfi-1)
:use-module (ice-9 format) ; for format-procedure
:use-module (ice-9 curried-definitions) ; for ensure
+ :use-module (calp translation)
:export (define-config)
)
@@ -41,7 +42,7 @@
(set! (it name) value)
(scm-error 'configuration-error
"define-config"
- "No configuration slot named ~s, when defining ~s"
+ (_ "No configuration slot named ~s, when defining ~s")
(list key name)
#f)))
(set-config! name (get-config name default-value)))
@@ -59,7 +60,9 @@
(or (it value)
(scm-error 'configuration-error
"set-config!"
- "Pre-property failed when setting ~s to ~s"
+ ;; first slot is property name, second is new
+ ;; property value.
+ (_ "Pre-property failed when setting ~s to ~s")
(list name value)
#f))
value))
@@ -74,7 +77,7 @@
(when (eq? v %uniq)
(scm-error 'configuration-error
"get-config"
- "No configuration item named ~s"
+ (_ "No configuration item named ~s")
(list key) #f))
v)
(hashq-ref config-values key default)))
@@ -125,7 +128,7 @@
(hash-map->list list config-values)))
`(*TOP*
- (header "Configuration variables")
+ (header ,(_ "Configuration variables"))
(dl
,@(concatenate
(for (module values) in groups
@@ -137,7 +140,8 @@
`((dt ,key)
(dd (p (@ (inline))
,(or (description key) "")))
- (dt "V:")
+ ;; Configuration variable value indicator
+ (dt ,(_ "V:"))
(dd ,(if (procedure? value)
(format-procedure value)
`(scheme ,value))
diff --git a/module/calp/util/exceptions.scm b/module/calp/util/exceptions.scm
index 1268f9f5..0588840e 100644
--- a/module/calp/util/exceptions.scm
+++ b/module/calp/util/exceptions.scm
@@ -1,7 +1,8 @@
(define-module (calp util exceptions)
:use-module (calp util config)
+ :use-module (calp translation)
:use-module (hnh util exceptions))
(define-config warnings-are-errors #f
- description: "Crash on warnings."
+ description: (_ "Crash on warnings.")
post: warnings-are-errors)