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/4d69dda728c54cba0ab7c9c... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4d69dda728c54cba0ab7c9c... You're receiving this email because of your account on gitlab.common-lisp.net.