[Git][cmucl/cmucl][issue-140-stream-element-type-two-way-stream] 7 commits: Fix #149: Call setlocale(3C) on startup
Raymond Toy (@rtoy)
gitlab at common-lisp.net
Mon Nov 14 22:57:30 UTC 2022
Raymond Toy pushed to branch issue-140-stream-element-type-two-way-stream at cmucl / cmucl
Commits:
33c760fa by Raymond Toy at 2022-11-03T04:47:09+00:00
Fix #149: Call setlocale(3C) on startup
- - - - -
317a33f8 by Raymond Toy at 2022-11-03T04:47:10+00:00
Merge branch 'issue-149-add-setlocale' into 'master'
Fix #149: Call setlocale(3C) on startup
Closes #149
See merge request cmucl/cmucl!105
- - - - -
7bbb4843 by Raymond Toy at 2022-11-08T03:19:19+00:00
Fix #155: Wrap help strings neatly
- - - - -
68f4ec70 by Raymond Toy at 2022-11-08T03:19:21+00:00
Merge branch 'issue-155-wrap-help-strings' into 'master'
Fix #155: Wrap help strings neatly
Closes #155
See merge request cmucl/cmucl!107
- - - - -
23f66902 by Raymond Toy at 2022-11-14T05:09:37+00:00
Fix #141: Use setlocale to handle localization settings
- - - - -
6764053d by Raymond Toy at 2022-11-14T05:09:38+00:00
Merge branch 'issue-141-locale' into 'master'
Fix #141: Use setlocale to handle localization settings
Closes #141, #136, #142, #146, #134, and #132
See merge request cmucl/cmucl!101
- - - - -
4cb049f3 by Raymond Toy at 2022-11-14T14:56:45-08:00
Merge branch 'master' into issue-140-stream-element-type-two-way-stream
- - - - -
7 changed files:
- src/code/commandline.lisp
- src/code/intl.lisp
- src/code/save.lisp
- src/code/unix.lisp
- src/general-info/release-21e.md
- src/i18n/locale/cmucl-unix.pot
- src/lisp/os-common.c
Changes:
=====================================
src/code/commandline.lisp
=====================================
@@ -339,16 +339,54 @@
(defun help-switch-demon (switch)
(declare (ignore switch))
(format t (intl:gettext "~&Usage: ~A <options>~2%") *command-line-utility-name*)
- (dolist (s (sort *legal-cmd-line-switches* #'string<
- :key #'car))
- (destructuring-bind (name doc arg)
- s
- (format t " -~A ~@[~A~]~%" name (if arg (intl:gettext arg)))
- ;; Poor man's formatting of the help string
- (with-input-from-string (stream (intl:gettext doc))
- (loop for line = (read-line stream nil nil)
- while line
- do (format t "~8T~A~%" line)))))
+ (flet
+ ((get-words (s)
+ (declare (string s))
+ ;; Return a list of all the words from S. A word is defined
+ ;; as any sequence of characters separated from others by
+ ;; whitespace consisting of space, newline, tab, formfeed, or
+ ;; carriage return.
+ (let ((end (length s)))
+ (loop for left = 0 then (+ right 1)
+ for right = (or
+ (position-if #'(lambda (c)
+ (member c
+ '(#\space #\newline #\tab #\ff #\cr)))
+ s
+ :start left)
+ end)
+ ;; Collect the word bounded by left and right in a list.
+ unless (and (= right left))
+ collect (subseq s left right) into subseqs
+ ;; Keep going until we reach the end of the string.
+ until (>= right end)
+ finally (return subseqs)))))
+
+ (dolist (s (sort *legal-cmd-line-switches* #'string<
+ :key #'car))
+ (destructuring-bind (name doc arg)
+ s
+ (format t " -~A ~@[~A~]~%" name (if arg (intl:gettext arg)))
+ ;; Poor man's formatting of the help string
+ (let ((*print-right-margin* 80))
+ ;; Extract all the words from the string and print them out
+ ;; one by one with a space between each, wrapping the output
+ ;; if needed. Each line is indented by 8 spaces.
+ ;;
+ ;; "~@< ~@;"
+ ;; per-line prefix of spaces and pass the whole arg list
+ ;; to this directive.
+ ;;
+ ;; "~{~A~^ ~}"
+ ;; loop over each word and print out the word followed by
+ ;; a space.
+ ;;
+ ;; "~:@>"
+ ;; No suffix, and insert conditional newline after each
+ ;; group of blanks if needed.
+ (format t "~@< ~@;~{~A~^ ~}~:@>"
+ (get-words (intl:gettext doc))))
+ (terpri))))
(ext:quit))
(defswitch "help" #'help-switch-demon
=====================================
src/code/intl.lisp
=====================================
@@ -520,10 +520,7 @@
(defun setlocale (&optional locale)
(setf *locale* (or locale
- (getenv "LANGUAGE")
- (getenv "LC_ALL")
- (getenv "LC_MESSAGES")
- (getenv "LANG")
+ (unix::unix-get-lc-messages)
*locale*)))
(defmacro textdomain (domain)
=====================================
src/code/save.lisp
=====================================
@@ -249,6 +249,10 @@
(reinit)
(environment-init)
(dolist (f *after-save-initializations*) (funcall f))
+ ;; Set the runtime locale
+ (unless (zerop (unix::unix-setlocale))
+ (warn "os_setlocale failed"))
+ ;; Set the locale for lisp
(intl::setlocale)
(ext::process-command-strings process-command-line)
(setf *editor-lisp-p* nil)
=====================================
src/code/unix.lisp
=====================================
@@ -2893,3 +2893,25 @@
of the child in the parent if it works, or NIL and an error number if it
doesn't work."
(int-syscall ("fork")))
+
+(defun unix-setlocale ()
+ _N"Call setlocale(3c) with fixed args. Returns 0 on success."
+ (alien:alien-funcall
+ (alien:extern-alien "os_setlocale"
+ (function c-call:int))))
+
+(defun unix-get-lc-messages ()
+ _N"Get LC_MESSAGES from the current locale. If we can't, return
+ NIL. A call to UNIX-SETLOCALE must have been done previously before
+ calling this so that the correct locale is returned."
+ (with-alien ((buf (array c-call:char 256)))
+ (let ((result
+ (alien-funcall
+ (extern-alien "os_get_lc_messages"
+ (function c-call:int
+ (* c-call:char)
+ c-call:int))
+ (cast buf (* c-call:char))
+ 256)))
+ (when (zerop result)
+ (cast buf c-call:c-string)))))
=====================================
src/general-info/release-21e.md
=====================================
@@ -61,8 +61,11 @@ public domain.
* ~~#136~~ `ensure-directories-exist` should return the given pathspec
* #139 `*default-external-format*` defaults to `:utf-8`
* ~~#140~~ External format of `two-way-stream`
+ * ~~#141~~ Disallow locales that are pathnames to a localedef file
* ~~#142~~ `(random 0)` signals incorrect error
- * ~~#147~~ `stream-line-column` method missing for `fundamental-character-output-stream`
+ * ~~#147~~ `stream-line-column` method missing for `fundamental-character-output-stream`
+ * ~~#149~~ Call setlocale(3C) on startup
+ * ~~#155~~ Wrap help strings neatly
* Other changes:
* Improvements to the PCL implementation of CLOS:
* Changes to building procedure:
=====================================
src/i18n/locale/cmucl-unix.pot
=====================================
@@ -1424,3 +1424,14 @@ msgid ""
" doesn't work."
msgstr ""
+#: src/code/unix.lisp
+msgid "Call setlocale(3c) with fixed args. Returns 0 on success."
+msgstr ""
+
+#: src/code/unix.lisp
+msgid ""
+"Get LC_MESSAGES from the current locale. If we can't, return\n"
+" NIL. A call to UNIX-SETLOCALE must have been done previously before\n"
+" calling this so that the correct locale is returned."
+msgstr ""
+
=====================================
src/lisp/os-common.c
=====================================
@@ -7,6 +7,7 @@
#include <assert.h>
#include <errno.h>
+#include <locale.h>
#include <math.h>
#include <netdb.h>
#include <pwd.h>
@@ -773,3 +774,25 @@ exit:
return result;
}
+
+int
+os_setlocale(void)
+{
+ char *result = setlocale(LC_ALL, "");
+
+ /* Return 0 if setlocale suceeded; otherwise -1. */
+ return result != NULL ? 0 : -1;
+}
+
+int
+os_get_lc_messages(char *buf, int len)
+{
+ char *locale = setlocale(LC_MESSAGES, NULL);
+ if (locale) {
+ strncpy(buf, locale, len - 1);
+ buf[len - 1] = '\0';
+ }
+
+ /* Return -1 if setlocale failed. */
+ return locale ? 0 : -1;
+}
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4d69dda728c54cba0ab7c9c084b8df8169771af0...4cb049f36ff1eeb1c2081c1800072a48221846e3
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4d69dda728c54cba0ab7c9c084b8df8169771af0...4cb049f36ff1eeb1c2081c1800072a48221846e3
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/20221114/a4e4dfe6/attachment-0001.html>
More information about the cmucl-cvs
mailing list