summaryrefslogtreecommitdiff
path: root/haunt.scm
diff options
context:
space:
mode:
Diffstat (limited to 'haunt.scm')
-rw-r--r--haunt.scm144
1 files changed, 12 insertions, 132 deletions
diff --git a/haunt.scm b/haunt.scm
index 7162ea4..6bbc884 100644
--- a/haunt.scm
+++ b/haunt.scm
@@ -19,7 +19,6 @@
;;; package manager.
;;; Once Haunt is installed, just run `haunt build` inside the directory
;;; containing this file.
-;;; TODO Well no because of translations, see the file NOTES.
;;; If you wish to contact me, find my contact information on:
;;; https://pelzflorian.de
@@ -30,10 +29,6 @@
;;; TODO USE MORE ARIA E.G. FOR LIST ELEMENTS
(use-modules
- (gettext-po)
- (system ffi-help-rt)
- ((system foreign)
- #:prefix ffi:)
(ice-9 i18n)
(ice-9 match)
(ice-9 regex)
@@ -54,135 +49,20 @@
(list "de"
"en"))
-(define (xerror-severity->string severity)
- "Returns the enum name for an integer specifying xerror severity."
- (cond ((= severity 0) "PO_SEVERITY_WARNING")
- ((= severity 1) "PO_SEVERITY_ERROR")
- ((= severity 2) "PO_SEVERITY_FATAL_ERROR")
- (else "")))
+(bindtextdomain "pelzfloriande" (getcwd))
+(bind-textdomain-codeset "pelzfloriande" "UTF-8")
+(textdomain "pelzfloriande")
-(define (xerror-output-proc-for-severity severity)
- "Given an xerror severity, returns which procedure to use to signal an \
-xerror."
- (if (= severity 2)
- error
- ;; otherwise:
- (lambda args
- (begin
- (apply simple-format #t args)
- (newline)))))
+(define (locale-for-lingua lingua)
+ (assoc-ref
+ '(("de" . "de_DE.UTF-8")
+ ("en" . "en_US.UTF-8"))
+ lingua))
-(define (xerror-handler
- severity
- message
- filename
- lineno
- column
- multiline-p1
- message-text)
- (let ((output (xerror-output-proc-for-severity severity)))
- (output "Gettext xerror occurred! ~A “~A” in ~A:~A."
- (xerror-severity->string severity)
- (ffi:pointer->string message-text)
- (ffi:pointer->string filename)
- lineno)))
-(define ~xerror-handler
- (ffi:procedure->pointer
- ffi:void
- xerror-handler
- (list ffi:int
- '*
- '*
- ffi:size_t
- ffi:size_t
- ffi:int
- '*)))
-
-(define (xerror2-handler severity message
- filename1 lineno1 column1 multiline-p1 message-text1
- filename2 lineno2 column2 multiline-p2 message-text2)
- (let ((output (xerror-output-proc-for-severity severity)))
- (output "Gettext xerror occurred! ~A “~A” in ~A:~A, “~A” in ~A:~A."
- (xerror-severity->string severity)
- (ffi:pointer->string message-text1)
- (ffi:pointer->string filename1)
- lineno1
- (ffi:pointer->string message-text2)
- (ffi:pointer->string filename2)
- lineno2)))
-(define ~xerror2-handler
- (ffi:procedure->pointer
- ffi:void
- xerror2-handler
- (list ffi:int
- '*
- '*
- ffi:size_t
- ffi:size_t
- ffi:int
- '*
- '*
- '*
- ffi:size_t
- ffi:size_t
- ffi:int '*)))
-
-(define xerror-handler-struct
- (let ((new (make-struct-po_xerror_handler)))
- (begin
- (fh-object-set! new 'xerror (ffi:pointer-address ~xerror-handler))
- (fh-object-set! new 'xerror2 (ffi:pointer-address ~xerror2-handler))
- new)))
-
-(define (translations-for-lingua lingua)
- "Returns po/<lingua>.po converted to an association list of msgid–msgstr \
-pairs."
- ;; TODO: STILL DISREGARDING PLURALS AND OTHER INFORMATION
- (let* ((po-file
- (po_file_read_v3
- (string-append "po/" lingua ".po")
- (pointer-to xerror-handler-struct)))
- (translations
- (if (ffi:null-pointer? (unwrap~pointer po-file))
- '()
- ;; otherwise:
- (let ((iter (po_message_iterator po-file ffi:%null-pointer)))
- (let loop ((message (po_next_message iter)))
- (if (ffi:null-pointer? (unwrap~pointer message))
- (begin
- (po_message_iterator_free iter)
- '())
- ;; otherwise:
- (cons
- (cons
- (ffi:pointer->string (po_message_msgid message))
- (ffi:pointer->string (po_message_msgstr message)))
- (loop (po_next_message iter)))))))))
- (if (not (ffi:null-pointer? (unwrap~pointer po-file)))
- (po_file_free po-file))
- translations))
-
-(define (translations-entry-for-lingua lingua)
- "Returns a pair of LINGUA and an association list of its translations."
- (cons
- lingua
- (translations-for-lingua lingua)))
-
-(define translated-msg
- ;; gettext is not used directly because it would require repeated
- ;; setlocale calls, which should not be necessary.
- ;; See: https://stackoverflow.com/questions/3398113/php-gettext-problems
- (let ((translation-lists
- (map translations-entry-for-lingua linguas)))
- (define (with-default value default)
- (if value value
- default))
- (lambda (msgid lingua)
- "Returns the msgstr for MSGID from the po file for LINGUA."
- (let ((translations (assoc-ref translation-lists lingua)))
- (with-default
- (assoc-ref translations msgid)
- msgid)))))
+(define (translated-msg msgid lingua)
+ (begin
+ (setlocale LC_ALL (locale-for-lingua lingua))
+ (gettext msgid)))
;; TODO: Unused translations; incorporate into po file later:
;;