- cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][issue-140-stream-element-type-two-way-stream] 7 commits: Fix #149: Call setlocale(3C) on startup
by Raymond Toy (＠rtoy) 14 Nov '22

14 Nov '22

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

1 0

[Git][cmucl/cmucl][issue-139-add-alias-local-external-format] 6 commits: Fix #155: Wrap help strings neatly
by Raymond Toy (＠rtoy) 14 Nov '22

14 Nov '22

Raymond Toy pushed to branch issue-139-add-alias-local-external-format at cmucl / cmucl Commits: 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 - - - - - 0a2144aa by Raymond Toy at 2022-11-14T14:38:55-08:00 Merge branch 'master' into issue-139-add-alias-local-external-format - - - - - 10f6311f by Raymond Toy at 2022-11-14T14:49:31-08:00 Fix merge mistake Accidentally deleted the test issue.139-default-external-format-write-file - - - - - 6 changed files: - src/code/commandline.lisp - src/code/intl.lisp - src/code/unix.lisp - src/general-info/release-21e.md - src/lisp/os-common.c - tests/issues.lisp 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/unix.lisp ===================================== @@ -2900,6 +2900,22 @@ (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))))) + (defun unix-get-locale-codeset () _N"Get the codeset from the locale" (with-alien ((codeset (array c-call:char 512))) ===================================== src/general-info/release-21e.md ===================================== @@ -59,11 +59,12 @@ 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 add alias for `:locale` external format + * #139 `*default-external-format*` defaults to `:utf-8`; add alias for `:locale` external format + * ~~#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` * ~~#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/lisp/os-common.c ===================================== @@ -785,6 +785,19 @@ os_setlocale(void) 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; +} + void os_get_locale_codeset(char* codeset, int len) { @@ -794,4 +807,3 @@ os_get_locale_codeset(char* codeset, int len) strncpy(codeset, code, len); } - ===================================== tests/issues.lisp ===================================== @@ -720,6 +720,30 @@ (assert-equal (map 'list #'char-name string) (map 'list #'char-name (read-line s)))))) +(define-test issue.139-default-external-format-write-file + (:tag :issues) + ;; Test that opening a file for writing uses the default :utf8. + ;; First write something out to the file. Then read it back in + ;; using an explicit format of utf8 and verifying that we got the + ;; right contents. + (let ((string (concatenate 'string + ;; This is "hello" in Korean + '(#\Hangul_syllable_an + #\Hangul_Syllable_Nyeong + #\Hangul_Syllable_Ha + #\Hangul_Syllable_Se + #\Hangul_Syllable_Yo)))) + (with-open-file (s (merge-pathnames "out-utf8.txt" + *test-path*) + :direction :output + :if-exists :supersede) + (write-line string s)) + (with-open-file (s (merge-pathnames "out-utf8.txt" + *test-path*) + :direction :input + :external-format :utf-8) + (assert-equal (map 'list #'char-name string) + (map 'list #'char-name (read-line s)))))) (define-test issue.139-locale-external-format (:tag :issues) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/af271f0b18e636871bb970… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/af271f0b18e636871bb970… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #141: Use setlocale to handle localization settings
by Raymond Toy (＠rtoy) 14 Nov '22

14 Nov '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 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 - - - - - 5 changed files: - src/code/intl.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/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/unix.lisp ===================================== @@ -2899,3 +2899,19 @@ (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 ===================================== @@ -60,6 +60,7 @@ public domain. * ~~#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` + * ~~#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` * ~~#149~~ Call setlocale(3C) on startup ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1428,3 +1428,10 @@ msgstr "" 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 ===================================== @@ -783,3 +783,16 @@ os_setlocale(void) /* 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/68f4ec706ced2efdf3e17f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/68f4ec706ced2efdf3e17f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-141-locale] Use LC_MESSAGES for intl::*locale*
by Raymond Toy (＠rtoy) 08 Nov '22

08 Nov '22

Raymond Toy pushed to branch issue-141-locale at cmucl / cmucl Commits: b935fbf1 by Raymond Toy at 2022-11-08T14:12:08-08:00 Use LC_MESSAGES for intl::*locale* For intl::setlocale, get the information from LC_MESSAGES; that's really what intl wants to know---the language to use for translations. To make it clearer, rename os_getlocale to os_get_lc_messages, and do the corresponding change for unix-get-lc-messages. Update the translation pot file because the docstring changed. - - - - - 4 changed files: - src/code/intl.lisp - src/code/unix.lisp - src/i18n/locale/cmucl-unix.pot - src/lisp/os-common.c Changes: ===================================== src/code/intl.lisp ===================================== @@ -520,7 +520,7 @@ (defun setlocale (&optional locale) (setf *locale* (or locale - (unix::unix-getlocale) + (unix::unix-get-lc-messages) *locale*))) (defmacro textdomain (domain) ===================================== src/code/unix.lisp ===================================== @@ -2900,14 +2900,14 @@ (alien:extern-alien "os_setlocale" (function c-call:int)))) -(defun unix-getlocale () - _N"Get 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." +(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_getlocale" + (extern-alien "os_get_lc_messages" (function c-call:int (* c-call:char) c-call:int)) ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1430,8 +1430,8 @@ msgstr "" #: src/code/unix.lisp msgid "" -"Get the current locale. If we can't, return NIL. A call to\n" -" UNIX-SETLOCALE must have been done previously before calling this so\n" -" that the correct locale is returned." +"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 ===================================== @@ -785,9 +785,9 @@ os_setlocale(void) } int -os_getlocale(char *buf, int len) +os_get_lc_messages(char *buf, int len) { - char *locale = setlocale(LC_ALL, NULL); + char *locale = setlocale(LC_MESSAGES, NULL); if (locale) { strncpy(buf, locale, len - 1); buf[len - 1] = '\0'; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b935fbf1ce1807fcb5323d7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b935fbf1ce1807fcb5323d7… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #155: Wrap help strings neatly
by Raymond Toy (＠rtoy) 08 Nov '22

08 Nov '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 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 - - - - - 2 changed files: - src/code/commandline.lisp - src/general-info/release-21e.md 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/general-info/release-21e.md ===================================== @@ -63,6 +63,7 @@ public domain. * ~~#142~~ `(random 0)` signals incorrect error * ~~#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: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/317a33f8d4031fd15c854e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/317a33f8d4031fd15c854e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-155-wrap-help-strings] Update release notes for issue #155
by Raymond Toy (＠rtoy) 07 Nov '22

07 Nov '22

Raymond Toy pushed to branch issue-155-wrap-help-strings at cmucl / cmucl Commits: c3c05139 by Raymond Toy at 2022-11-07T15:50:16-08:00 Update release notes for issue #155 - - - - - 1 changed file: - src/general-info/release-21e.md Changes: ===================================== src/general-info/release-21e.md ===================================== @@ -63,6 +63,7 @@ public domain. * ~~#142~~ `(random 0)` signals incorrect error * ~~#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: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c3c0513933be2f9c4f8b13e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c3c0513933be2f9c4f8b13e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-155-wrap-help-strings
by Raymond Toy (＠rtoy) 07 Nov '22

07 Nov '22

Raymond Toy pushed new branch issue-155-wrap-help-strings at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-155-wrap-help-strin… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-141-locale] Restore missing line
by Raymond Toy (＠rtoy) 05 Nov '22

05 Nov '22

Raymond Toy pushed to branch issue-141-locale at cmucl / cmucl Commits: ca4a91c4 by Raymond Toy at 2022-11-05T08:33:57-07:00 Restore missing line Somehow, I deleted the line that said the `locale` arg to `intl::setlocale` took precedence over the system locale. Restore the line. This now makes more sense. - - - - - 1 changed file: - src/code/intl.lisp Changes: ===================================== src/code/intl.lisp ===================================== @@ -519,7 +519,8 @@ (if (equal val "") nil val))) (defun setlocale (&optional locale) - (setf *locale* (or (unix::unix-getlocale) + (setf *locale* (or locale + (unix::unix-getlocale) *locale*))) (defmacro textdomain (domain) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ca4a91c47aabca48c15a3af… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ca4a91c47aabca48c15a3af… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-141-locale] 13 commits: Fix #147: Add method for stream-line-column
by Raymond Toy (＠rtoy) 05 Nov '22

05 Nov '22

Raymond Toy pushed to branch issue-141-locale at cmucl / cmucl Commits: e8a0cc6c by Raymond Toy at 2022-10-30T15:03:27+00:00 Fix #147: Add method for stream-line-column - - - - - 0dad5a1a by Raymond Toy at 2022-10-30T15:03:28+00:00 Merge branch 'issue-147-stream-line-column-impl' into 'master' Fix #147: Add method for stream-line-column Closes #147 See merge request cmucl/cmucl!104 - - - - - 1300830b by Raymond Toy at 2022-10-31T17:12:48+00:00 Address #139: *default-external-format* is :utf-8 - - - - - 649a4f1e by Raymond Toy at 2022-10-31T17:12:49+00:00 Merge branch 'issue-139-default-external-format-utf8' into 'master' Address #139: *default-external-format* is :utf-8 See merge request cmucl/cmucl!103 - - - - - 88f6852f by Raymond Toy at 2022-11-01T12:04:55-07:00 Change :iso-8859-1 to :iso8859-1 in find-encoding While there's an alias for `:iso-8859-1`, it's safer to use `:iso8859-1` which is builtin. Using `:iso-8859-1` requires the alias database to be loaded, which isn't (currently) guaranteed when `find-encoding` is called. Thus use the builtin name instead. Besides, `:iso8859-1` is used in other places in "intl.lisp". (This is hard to test, but I noticed it when running ``` LANG=ko_KR.utf8 lisp ``` on the branch `issue-139-add-alias-local-external-format`.) - - - - - d5f1aa5e by Raymond Toy at 2022-11-01T20:35:49+00:00 Update release-21e.md with closed issues. - - - - - 402c0c01 by Raymond Toy at 2022-11-02T01:00:20+00:00 Fix #150: add aliases cp949 euckr - - - - - d825aa54 by Raymond Toy at 2022-11-02T01:00:20+00:00 Merge branch 'issue-150-add-aliases-cp949-euckr' into 'master' Fix #150: add aliases cp949 euckr Closes #150 See merge request cmucl/cmucl!106 - - - - - 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 - - - - - 390f8f3f by Raymond Toy at 2022-11-04T18:14:01-07:00 Update release notes - - - - - 2c5282bf by Raymond Toy at 2022-11-04T18:48:48-07:00 Merge branch 'master' into issue-141-locale - - - - - 1dbc1061 by Raymond Toy at 2022-11-04T19:13:13-07:00 Implement unix-getlocale and use it * lisp/os-common.c * Implement os_getlocale to get the current locale via setlocale(3C) * code/unix.lisp * Define function unix-getlocale to call os_getlocale * code/intl.lisp * Use unix-getlocale to get the locale instead of geting the different environment variables. * i18n/locale/cmucl-unix.pot * Update because of the new docstring - - - - - 12 changed files: - src/code/extfmts.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 - src/pcl/gray-streams.lisp - src/pcl/simple-streams/external-formats/aliases - + tests/.gitignore - tests/issues.lisp - + tests/utf8.txt Changes: ===================================== src/code/extfmts.lisp ===================================== @@ -22,7 +22,7 @@ describe-external-format)) (defvar *default-external-format* - :iso8859-1 + :utf-8 "The default external format to use if no other external format is specified") ===================================== src/code/intl.lisp ===================================== @@ -105,7 +105,7 @@ (defun find-encoding (domain) (when (null (domain-entry-encoding domain)) - (setf (domain-entry-encoding domain) :iso-8859-1) + (setf (domain-entry-encoding domain) :iso8859-1) ;; Domain lookup can call the compiler, so set the locale to "C" ;; so things work. (let* ((*locale* "C") @@ -519,18 +519,8 @@ (if (equal val "") nil val))) (defun setlocale (&optional locale) - (let ((env-locale (or locale - (getenv "LANGUAGE") - (getenv "LC_ALL") - (getenv "LC_MESSAGES") - (getenv "LANG")))) - (cond - ((and (plusp (length env-locale)) - (char-equal #\/ (aref env-locale 0))) - (warn "Locale not changed due to unsupported locale: ~S" env-locale)) - (t - (setf *locale* (or env-locale - *locale*)))))) + (setf *locale* (or (unix::unix-getlocale) + *locale*))) (defmacro textdomain (domain) `(eval-when (:compile-toplevel :execute) ===================================== 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-getlocale () + _N"Get 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_getlocale" + (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 ===================================== @@ -22,6 +22,7 @@ public domain. * Feature enhancements * Changes * Update to ASDF 3.3.6 + * The default external format is `:utf-8` instead of `:iso8859-1` * ANSI compliance fixes: * Bug fixes: * ~~#97~~ Fixes stepping through the source forms in the debugger. This has been broken for quite some time, but it works now. @@ -50,13 +51,19 @@ public domain. * ~~#113~~ REQUIRE on contribs can pull in the wrong things via ASDF.. * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * ~~#122~~ gcc 11 can't build cmucl + * ~~#124~~ directory with `:wild-inferiors` doesn't descend subdirectories * ~~#125~~ Linux `unix-stat` returning incorrect values * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid.. * ~~#128~~ `QUIT` accepts an exit code + * ~~#130~~ Move file-author to C * ~~#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` + * ~~#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` + * ~~#149~~ Call setlocale(3C) on startup * 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 the current locale. If we can't, return NIL. A call to\n" +" UNIX-SETLOCALE must have been done previously before calling this so\n" +" 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_getlocale(char *buf, int len) +{ + char *locale = setlocale(LC_ALL, NULL); + if (locale) { + strncpy(buf, locale, len - 1); + buf[len - 1] = '\0'; + } + + /* Return -1 if setlocale failed. */ + return locale ? 0 : -1; +} ===================================== src/pcl/gray-streams.lisp ===================================== @@ -235,6 +235,9 @@ defined for this function, although it is permissible for it to always return NIL.")) +(defmethod stream-line-column ((stream fundamental-character-output-stream)) + nil) + ;;; Stream-line-length is a CMUCL extension to Gray streams. (defgeneric stream-line-length (stream) (:documentation _N"Return the stream line length or Nil.")) ===================================== src/pcl/simple-streams/external-formats/aliases ===================================== @@ -223,6 +223,8 @@ windows-cp1252 cp1252 windows-latin1 cp1252 ms-ansi cp1252 +euckr euc-kr +cp949 euc-kr ;; These are not yet implemented ;;iso-2022-jp iso2022-jp ;;iso2022jp iso2022-jp ===================================== tests/.gitignore ===================================== @@ -0,0 +1 @@ +/out-utf8.txt ===================================== tests/issues.lisp ===================================== @@ -5,6 +5,12 @@ (in-package "ISSUES-TESTS") +(defparameter *test-path* + (merge-pathnames (make-pathname :name :unspecific :type :unspecific + :version :unspecific) + *load-truename*) + "Path to where this file is.") + (defun square (x) (expt x 2)) @@ -676,4 +682,73 @@ ;; work and not return NIL. (assert-true (file-author ".")) (assert-true (file-author "bin/build.sh")) - (assert-true (file-author "tests/안녕하십니까.txt"))) + (let ((unix::*filename-encoding* :utf-8)) + ;; Set filename encoding to utf-8 so that we can encode the + ;; filename properly. + (assert-true + (file-author + (merge-pathnames + (concatenate 'string + ;; Write the test file name this way so + ;; that it's independent of the encoding + ;; used to load this file. The name is + ;; "안녕하십니까". + '(#\Hangul_Syllable_An #\Hangul_Syllable_Nyeong #\Hangul_Syllable_Ha + #\Hangul_Syllable_Sib #\Hangul_Syllable_Ni #\Hangul_Syllable_Gga) + ".txt") + *test-path*))))) + +(define-test issue.139-default-external-format + (:tag :issues) + (assert-eq :utf-8 stream:*default-external-format*)) + +(define-test issue.139-default-external-format-read-file + (:tag :issues) + (let ((string (concatenate 'string + ;; This is "hello" in Korean + '(#\Hangul_syllable_an + #\Hangul_Syllable_Nyeong + #\Hangul_Syllable_Ha + #\Hangul_Syllable_Se + #\Hangul_Syllable_Yo)))) + ;; Test that opening a file for reading uses the the default :utf8 + ;; encoding. + (with-open-file (s (merge-pathnames "utf8.txt" + *test-path*) + :direction :input) + ;; The first line should be "hello" in Hangul. + (assert-equal (map 'list #'char-name string) + (map 'list #'char-name (read-line s)))))) + +(define-test issue.139-default-external-format-write-file + (:tag :issues) + ;; Test that opening a file for writing uses the default :utf8. + ;; First write something out to the file. Then read it back in + ;; using an explicit format of utf8 and verifying that we got the + ;; right contents. + (let ((string (concatenate 'string + ;; This is "hello" in Korean + '(#\Hangul_syllable_an + #\Hangul_Syllable_Nyeong + #\Hangul_Syllable_Ha + #\Hangul_Syllable_Se + #\Hangul_Syllable_Yo)))) + (with-open-file (s (merge-pathnames "out-utf8.txt" + *test-path*) + :direction :output + :if-exists :supersede) + (write-line string s)) + (with-open-file (s (merge-pathnames "out-utf8.txt" + *test-path*) + :direction :input + :external-format :utf-8) + (assert-equal (map 'list #'char-name string) + (map 'list #'char-name (read-line s)))))) + + +(define-test issue.150 + (:tag :issues) + (let ((ext:*gc-verbose* nil) + (*compile-print* nil)) + (assert-true (stream::find-external-format :euckr)) + (assert-true (stream::find-external-format :cp949)))) ===================================== tests/utf8.txt ===================================== @@ -0,0 +1,2 @@ +안녕하세요 +UTF8 test. The above line is "Hello" in Hangul. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6e975c79c794bb61d18fa0… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6e975c79c794bb61d18fa0… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-139-add-alias-local-external-format] 3 commits: Add comment
by Raymond Toy (＠rtoy) 03 Nov '22

03 Nov '22

Raymond Toy pushed to branch issue-139-add-alias-local-external-format at cmucl / cmucl Commits: e413e19b by Raymond Toy at 2022-11-03T15:41:40-07:00 Add comment - - - - - 15a17fae by Raymond Toy at 2022-11-03T16:16:28-07:00 Add test, more comments, and set alias earlier Set the `:locale` alias early in the startup so it's available early. Add simple test that the `:locale` alias exists. Update the pot files due to changed docstrings. - - - - - af271f0b by Raymond Toy at 2022-11-03T16:17:19-07:00 Update release notes for :locale alias - - - - - 5 changed files: - src/code/save.lisp - src/general-info/release-21e.md - src/i18n/locale/cmucl-unix.pot - src/i18n/locale/cmucl.pot - tests/issues.lisp Changes: ===================================== src/code/save.lisp ===================================== @@ -144,7 +144,7 @@ (defun set-up-locale-external-format () "Add external format alias for :locale to the format specified by - the envvar LANG and friends if available." + 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 @@ -276,9 +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) @@ -323,7 +327,6 @@ (when process-command-line (ext::invoke-switch-demons *command-line-switches* *command-switch-demons*)) - (set-up-locale-external-format) (when (and print-herald (not (or quiet (and process-command-line ===================================== src/general-info/release-21e.md ===================================== @@ -60,6 +60,7 @@ public domain. * ~~#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 add alias for `:locale` external format * ~~#142~~ `(random 0)` signals incorrect error * ~~#147~~ `stream-line-column` method missing for `fundamental-character-output-stream` * ~~#149~~ Call setlocale(3C) on startup ===================================== src/i18n/locale/cmucl-unix.pot ===================================== @@ -1428,3 +1428,7 @@ msgstr "" msgid "Call setlocale(3c) with fixed args. Returns 0 on success." 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" ===================================== tests/issues.lisp ===================================== @@ -720,31 +720,11 @@ (assert-equal (map 'list #'char-name string) (map 'list #'char-name (read-line s)))))) -(define-test issue.139-default-external-format-write-file + +(define-test issue.139-locale-external-format (:tag :issues) - ;; Test that opening a file for writing uses the default :utf8. - ;; First write something out to the file. Then read it back in - ;; using an explicit format of utf8 and verifying that we got the - ;; right contents. - (let ((string (concatenate 'string - ;; This is "hello" in Korean - '(#\Hangul_syllable_an - #\Hangul_Syllable_Nyeong - #\Hangul_Syllable_Ha - #\Hangul_Syllable_Se - #\Hangul_Syllable_Yo)))) - (with-open-file (s (merge-pathnames "out-utf8.txt" - *test-path*) - :direction :output - :if-exists :supersede) - (write-line string s)) - (with-open-file (s (merge-pathnames "out-utf8.txt" - *test-path*) - :direction :input - :external-format :utf-8) - (assert-equal (map 'list #'char-name string) - (map 'list #'char-name (read-line s)))))) - + ;; Just verify that :locale format exists + (assert-true (stream::find-external-format :locale nil))) (define-test issue.150 (:tag :issues) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f45d931fc9cc9e8b062847… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f45d931fc9cc9e8b062847… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0