guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

17/18: installer: Provide verbose description of locale.


From: John Darrington
Subject: 17/18: installer: Provide verbose description of locale.
Date: Thu, 2 Feb 2017 18:13:05 +0000 (UTC)

jmd pushed a commit to branch wip-installer
in repository guix.

commit 10418a2e1a1cd299db714d00afd76b54a0364f48
Author: John Darrington <address@hidden>
Date:   Thu Feb 2 08:35:42 2017 +0100

    installer: Provide verbose description of locale.
    
    * gnu/system/installer/locale.scm (locale-description): New procedure,
    and use it in the locale-page-init.
---
 gnu/system/installer/locale.scm |   25 ++++++++++++++++++++++++-
 1 file changed, 24 insertions(+), 1 deletion(-)

diff --git a/gnu/system/installer/locale.scm b/gnu/system/installer/locale.scm
index 08de543..4136010 100644
--- a/gnu/system/installer/locale.scm
+++ b/gnu/system/installer/locale.scm
@@ -100,6 +100,26 @@
   #f
   )
 
+(define (locale-description locale)
+  "Return a string describing LOCALE"
+  (define loc #f)
+  (define lc-all "LC_ALL")
+  (dynamic-wind
+      (lambda () (set! loc (getenv lc-all))
+              (setenv lc-all locale))
+      (lambda () (let ((str (assq-ref (key-value-slurp
+                            (string-append "locale -k LC_IDENTIFICATION"))
+                                      'title)))
+                   ;; String enclosing "" if they exist
+                   (if (and (eqv? (string-ref str 0) #\")
+                            (eqv? (string-ref str (1- (string-length str))) 
#\"))
+                       (substring str 1 (1- (string-length str)))
+                       str)))
+      (lambda ()
+        (if loc
+            (setenv lc-all loc)
+            (unsetenv lc-all)))))
+
 (define (locale-page-init p)
   (let* ((s (page-surface p))
         (frame (make-boxed-window  #f
@@ -124,7 +144,10 @@
 
         (menu (make-menu %default-locale-definitions
                           #:disp-proc (lambda (d row)
-                                        (locale-definition-name d)))))
+                                        (format #f "~60a ~10a"
+                                        (locale-description
+                                         (locale-definition-name d))
+                                         (locale-definition-name d))))))
 
     (push-cursor (page-cursor-visibility p))
     (page-set-datum! p 'text-window text-window)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]