Beter layouting

translate.rkt

@@ -2,6 +2,7 @@
 
 (require db
          racket/file
+         racket/list
          racket/string
          "private/config.rkt"
          "private/database.rkt")
@@ -10,11 +11,12 @@
          translations-for
          current-language
          write-language!
-         translation-page-slug)
+         translation-page-slug
+         translation-page-template)
 
 (define english
   (hash
-   'users "Users" 'translations "Translations" 'todo "Todo"
+   'users "Users" 'translations "Translations" 'todo "Todo" 'todo-list "Todo list" 'admin "Admin" 'role-reader "reader" 'role-editor "editor" 'role-admin "admin"
    'search-wiki "Search wiki" 'contents "Contents" 'pages "Pages"
    'edit "Edit" 'history "History" 'delete "Delete" 'page-not-found "Page not found"
    'cancel "Cancel" 'save "Save" 'page-title "Page title" 'tags "Tags (comma separated)"
@@ -47,14 +49,14 @@
 
 (define dutch
   (hash
-   'users "Gebruikers" 'translations "Vertalingen" 'todo "Todo"
+   'users "Gebruikers" 'translations "Vertalingen" 'todo "Todo" 'todo-list "Todo-lijst" 'admin "Admin" 'role-reader "lezer" 'role-editor "redacteur" 'role-admin "admin"
    'search-wiki "Wiki doorzoeken" 'contents "Inhoud" 'pages "Pagina's"
    'edit "Bewerken" 'history "Geschiedenis" 'delete "Verwijderen" 'page-not-found "Pagina niet gevonden"
    'cancel "Annuleren" 'save "Opslaan" 'page-title "Paginatitel" 'tags "Tags (komma-gescheiden)"
    'version-summary "Versiesamenvatting (optioneel)" 'search "Zoeken" 'page-history "Paginageschiedenis"
    'back "Terug" 'user-administration "Gebruikersbeheer" 'username "Gebruikersnaam"
    'display-name "Weergavenaam" 'initial-password "Initieel wachtwoord" 'create-user "Gebruiker aanmaken"
-   'sign-in "Inloggen" 'sign-out "Uitloggen" 'password "Wachtwoord"
+   'sign-in "Inloggen" 'sign-out "Afmelden" 'password "Wachtwoord"
    'upload-image "Afbeelding uploaden" 'upload-file "Bestand uploaden" 'saved "Opgeslagen"
    'offline "Offline" 'online "Online" 'todo-items "Todo-items"
    'no-todos "Geen todo-items." 'no-matching-pages "Geen overeenkomende pagina's."
@@ -80,6 +82,7 @@
 
 (define (base-translations language)
   (if (string-ci=? language "nl") dutch english))
+
 (define (current-language config)
   (with-handlers ((exn:fail? (λ (_e) (wiki-config-language config))))
     (if (file-exists? (language-config-path config))
@@ -98,9 +101,85 @@
     #:exists 'truncate/replace)
   (void))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return the slug of the special translations page.
+; pre    : none; language is accepted for compatibility with older callers.
+; post   : no state is changed.
+; result : The fixed wiki-translations slug.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (translation-page-slug [language #f])
+  "wiki-translations")
 
-(define (translation-page-slug language)
-  (string-append "wiki-translations-" (string-downcase language)))
+(define (translation-value-needs-quotes? value)
+  (or (string-contains? value ",")
+      (string-contains? value "\"")
+      (not (string=? value (string-trim value)))))
+
+(define (translation-value->text value)
+  (if (translation-value-needs-quotes? value)
+      (string-append "\""
+                     (string-replace (string-replace value "\\" "\\\\") "\"" "\\\"")
+                     "\"")
+      value))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Build the initial contents of the special translations page.
+; pre    : the built-in translation tables are available.
+; post   : no state is changed.
+; result : Text containing every known key with nl and en values.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (translation-page-template)
+  (define keys
+    (sort (remove-duplicates (append (hash-keys english) (hash-keys dutch)))
+          string<?
+          #:key symbol->string))
+  (string-join
+   (for/list ((key (in-list keys)))
+     (format "~a = nl:~a, en:~a"
+             (symbol->string key)
+             (translation-value->text (hash-ref dutch key (hash-ref english key "")))
+             (translation-value->text (hash-ref english key ""))))
+   "\n"))
+
+(define (unquote-translation-value value)
+  (define text (string-trim value))
+  (if (and (>= (string-length text) 2)
+           (char=? (string-ref text 0) #\")
+           (char=? (string-ref text (sub1 (string-length text))) #\"))
+      (let ((body (substring text 1 (sub1 (string-length text)))))
+        (string-replace (string-replace body "\\\"" "\"") "\\\\" "\\"))
+      text))
+
+(define (split-translation-variants text)
+  (let loop ((i 0)
+             (start 0)
+             (quoted? #f)
+             (escaped? #f)
+             (result '()))
+    (if (>= i (string-length text))
+        (reverse (cons (substring text start i) result))
+        (let ((ch (string-ref text i)))
+          (cond
+            (escaped?
+             (loop (add1 i) start quoted? #f result))
+            ((and quoted? (char=? ch #\\))
+             (loop (add1 i) start quoted? #t result))
+            ((char=? ch #\")
+             (loop (add1 i) start (not quoted?) #f result))
+            ((and (not quoted?) (char=? ch #\,))
+             (loop (add1 i) (add1 i) #f #f (cons (substring text start i) result)))
+            (else
+             (loop (add1 i) start quoted? #f result)))))))
+
+(define (parse-translation-variants text)
+  (for/fold ((result (hash)))
+            ((part (in-list (split-translation-variants text))))
+    (define match (regexp-match #px"^\\s*([A-Za-z][A-Za-z0-9_-]*)\\s*:(.*)$" part))
+    (if match
+        (hash-set result
+                  (string-downcase (list-ref match 1))
+                  (unquote-translation-value (list-ref match 2)))
+        result)))
 
 (define (parse-overrides markdown)
   (for/fold ((result (hash)))
@@ -108,9 +187,10 @@
     (define match
       (regexp-match #px"^\\s*([A-Za-z0-9._-]+)\\s*=\\s*(.*?)\\s*$" line))
     (if match
-        (hash-set result
-                  (string->symbol (list-ref match 1))
-                  (list-ref match 2))
+        (let ((variants (parse-translation-variants (list-ref match 2))))
+          (if (zero? (hash-count variants))
+              result
+              (hash-set result (string->symbol (list-ref match 1)) variants)))
         result)))
 
 (define (database-overrides config)
@@ -123,9 +203,18 @@
            (define markdown
              (query-maybe-value db
                                 "SELECT markdown FROM pages WHERE slug = $1 AND archived = FALSE"
-                                (translation-page-slug (current-language config))))
+                                (translation-page-slug)))
            (if markdown (parse-overrides markdown) (hash)))))))
 
+(define (translation-override-for-language variants language)
+  (define language-key (string-downcase language))
+  (cond
+    ((hash-has-key? variants language-key)
+     (hash-ref variants language-key))
+    ((hash-has-key? variants "en")
+     (hash-ref variants "en"))
+    (else #f)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Return all translations active for the configured wiki language.
 ; pre    : config is a wiki-config value.
@@ -133,9 +222,13 @@
 ; result : A hash from translation symbols to strings.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (translations-for config)
-  (for/fold ((result (base-translations (current-language config))))
-            (((key value) (in-hash (database-overrides config))))
-    (hash-set result key value)))
+  (define language (current-language config))
+  (for/fold ((result (base-translations language)))
+            (((key variants) (in-hash (database-overrides config))))
+    (define value (translation-override-for-language variants language))
+    (if value
+        (hash-set result key value)
+        result)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Translate one UI key for the configured wiki language.