[Git][cmucl/cmucl][issue-139-add-alias-local-external-format] 6 commits: Fix #155: Wrap help strings neatly
Raymond Toy (@rtoy)
gitlab at common-lisp.net
Mon Nov 14 22:49:48 UTC 2022
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/af271f0b18e636871bb970e1ebfb3501ecd8d324...10f6311f91ae56ce58b57e4bd412a5351f78737a
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/af271f0b18e636871bb970e1ebfb3501ecd8d324...10f6311f91ae56ce58b57e4bd412a5351f78737a
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/d78d0518/attachment-0001.html>
More information about the cmucl-cvs
mailing list