hans/racket-wiki
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactoring by skill

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-29 22:22:49 +02:00
parent 67fce7a330
commit 649ff0d7c5
22 changed files with 1598 additions and 1644 deletions
Download Patch File Download Diff File Expand all files Collapse all files
translate.rkt
+65 -53
View File
@@ -279,15 +279,27 @@
(define (base-translations language)
(if (string-ci=? language "nl") dutch english))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Read the language selected for this wiki installation.
; pre : config is a wiki-config value.
; post : The language file, when present, has only been read.
; result : The stored language string, or the language from config as fallback.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (current-language config)
(with-handlers ((exn:fail? (λ (_e) (wiki-config-language config))))
(if (file-exists? (language-config-path config))
(call-with-input-file (language-config-path config)
(λ (in)
(define value (read in))
(if (string? value) value (wiki-config-language config))))
(let ((value (read in)))
(if (string? value) value (wiki-config-language config)))))
(wiki-config-language config))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Persist the selected wiki language.
; pre : config is a wiki-config value and language is a string.
; post : language.rktd contains language below the configured data directory.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (write-language! config language)
(make-directory* (wiki-config-data-dir config))
(call-with-output-file (language-config-path config)
@@ -325,26 +337,26 @@
; 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"))
(let ((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))
(let ((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)
@@ -370,24 +382,24 @@
(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)))
(let ((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)))
((line (in-list (string-split markdown "\n"))))
(define match
(regexp-match #px"^\\s*([A-Za-z0-9._-]+)\\s*=\\s*(.*?)\\s*$" line))
(if match
(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)))
(let ((match
(regexp-match #px"^\\s*([A-Za-z0-9._-]+)\\s*=\\s*(.*?)\\s*$" line)))
(if match
(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)
(with-handlers ((exn:fail? (λ (_e) (hash))))
@@ -396,20 +408,20 @@
(call-with-wiki-database
config
(λ (db)
(define markdown
(query-maybe-value db
"SELECT markdown FROM pages WHERE namespace = '' AND slug = $1 AND archived = FALSE"
(translation-page-slug)))
(if markdown (parse-overrides markdown) (hash)))))))
(let ((markdown
(query-maybe-value db
"SELECT markdown FROM pages WHERE namespace = '' AND slug = $1 AND archived = FALSE"
(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)))
(let ((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.
@@ -418,13 +430,13 @@
; result : A hash from translation symbols to strings.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (translations-for config)
(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)))
(let ((language (current-language config)))
(for/fold ((result (base-translations language)))
(((key variants) (in-hash (database-overrides config))))
(let ((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.