[Git][cmucl/cmucl][master] 2 commits: Address #139: Add :locale external format

[Raymond Toy (@rtoy)]

Raymond Toy pushed to branch master at cmucl / cmucl


Commits:
225940e4 by Raymond Toy at 2022-11-25T16:07:57+00:00
Address #139:  Add :locale external format

- - - - -
bea34994 by Raymond Toy at 2022-11-25T16:07:57+00:00
Merge branch 'issue-139-add-alias-local-external-format' into 'master'

Address #139:  Add :locale external format

See merge request cmucl/cmucl!102
- - - - -


7 changed files:

- src/code/save.lisp
- src/code/unix.lisp
- src/general-info/release-21e.md
- src/i18n/locale/cmucl-unix.pot
- src/i18n/locale/cmucl.pot
- src/lisp/os-common.c
- tests/issues.lisp


Changes:

=====================================
src/code/save.lisp
=====================================
@@ -142,6 +142,30 @@
   (file c-call:c-string)
   (initial-function (alien:unsigned #.vm:word-bits)))
 
+(defun set-up-locale-external-format ()
+  "Add external format alias for :locale to the format specified by
+  the locale as set by setlocale(3C)."
+  (let ((codeset (unix::unix-get-locale-codeset)))
+    (cond ((zerop (length codeset))
+	   ;; Codeset was the empty string, so just set :locale to
+	   ;; alias to the default external format.  
+	   (setf (gethash :locale stream::*external-format-aliases*)
+		 *default-external-format*))
+	  (t
+	   (let ((codeset-format (intern codeset "KEYWORD")))
+	     ;; If we know the format, we can set the alias.
+	     ;; Otherwise, print a warning and use :iso8859-1 as the
+	     ;; alias.
+	     (setf (gethash :locale stream::*external-format-aliases*)
+		   (if (stream::find-external-format codeset-format nil)
+		       codeset-format
+		       (progn
+			 (warn "Unsupported external format; using :iso8859-1 instead: ~S"
+			       codeset-format)
+			 :iso8859-1)))))))
+  (values))
+
+ 
 (defun save-lisp (core-file-name &key
 				 (purify t)
 				 (root-structures ())
@@ -252,8 +276,13 @@
 	     ;; Set the runtime locale
 	     (unless (zerop (unix::unix-setlocale))
 	       (warn "os_setlocale failed"))
+	     ;; Load external format aliases now so we can aliases to
+	     ;; specify the external format.
+	     (stream::load-external-format-aliases)
 	     ;; Set the locale for lisp
 	     (intl::setlocale)
+	     ;; Set up :locale format
+	     (set-up-locale-external-format)
 	     (ext::process-command-strings process-command-line)
 	     (setf *editor-lisp-p* nil)
 	     (macrolet ((find-switch (name)


=====================================
src/code/unix.lisp
=====================================
@@ -2915,3 +2915,10 @@
 	     256)))
       (when (zerop result)
 	(cast buf c-call:c-string)))))
+
+(defun unix-get-locale-codeset ()
+  _N"Get the codeset from the locale"
+  (cast (alien-funcall
+	    (extern-alien "os_get_locale_codeset"
+			  (function (* char))))
+	c-string))


=====================================
src/general-info/release-21e.md
=====================================
@@ -59,7 +59,7 @@ public domain.
     * ~~#132~~ Ansi test `RENAME-FILE.1` no fails
     * ~~#134~~ Handle the case of `(expt complex complex-rational)`
     * ~~#136~~ `ensure-directories-exist` should return the given pathspec
-    * #139 `*default-external-format*` defaults to `:utf-8`
+    * #139 `*default-external-format*` defaults to `:utf-8`; add alias for `:locale` external format
     * ~~#140~~ External format for streams that are not `file-stream`'s
     * ~~#141~~ Disallow locales that are pathnames to a localedef file
     * ~~#142~~ `(random 0)` signals incorrect error


=====================================
src/i18n/locale/cmucl-unix.pot
=====================================
@@ -1435,3 +1435,7 @@ msgid ""
 "  calling this so that the correct locale is returned."
 msgstr ""
 
+#: src/code/unix.lisp
+msgid "Get the codeset from the locale"
+msgstr ""
+


=====================================
src/i18n/locale/cmucl.pot
=====================================
@@ -6714,6 +6714,12 @@ msgid ""
 "This is true if and only if the lisp was started with the -edit switch."
 msgstr ""
 
+#: src/code/save.lisp
+msgid ""
+"Add external format alias for :locale to the format specified by\n"
+"  the locale as set by setlocale(3C)."
+msgstr ""
+
 #: src/code/save.lisp
 msgid ""
 "Saves a CMU Common Lisp core image in the file of the specified name.  The\n"


=====================================
src/lisp/os-common.c
=====================================
@@ -7,6 +7,7 @@
 
 #include <assert.h>
 #include <errno.h>
+#include <langinfo.h>
 #include <locale.h>
 #include <math.h>
 #include <netdb.h>
@@ -796,3 +797,9 @@ os_get_lc_messages(char *buf, int len)
     /* Return -1 if setlocale failed. */
     return locale ? 0 : -1;
 }
+
+char *
+os_get_locale_codeset()
+{
+    return nl_langinfo(CODESET);
+}


=====================================
tests/issues.lisp
=====================================
@@ -745,6 +745,11 @@
       (assert-equal (map 'list #'char-name string)
 		    (map 'list #'char-name (read-line s))))))
   
+(define-test issue.139-locale-external-format
+    (:tag :issues)
+  ;; Just verify that :locale format exists
+  (assert-true (stream::find-external-format :locale nil)))
+
 ;;; Test stream-external-format for various types of streams.
 
 (define-test issue.140.two-way-stream
@@ -792,7 +797,6 @@
 		      (stream-external-format
 		       (make-broadcast-stream s1 s2 s3)))))))
 
-
 (define-test issue.150
     (:tag :issues)
   (let ((ext:*gc-verbose* nil)



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/88843edcf0a2968c8da4b01248aa83f2a84a5a0e...bea349948b06626fd33026500bb2ec70a8e8f56c

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/88843edcf0a2968c8da4b01248aa83f2a84a5a0e...bea349948b06626fd33026500bb2ec70a8e8f56c
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20221125/0c8ab4fc/attachment-0001.html>