+  (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))))

+		     (unix::unix-get-lc-messages)

+(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)))))

+

+    * #139 `*default-external-format*` defaults to `:utf-8`; add alias for `:locale` external format

+    * ~~#141~~ Disallow locales that are pathnames to a localedef file

+    * ~~#155~~ Wrap help strings neatly

+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;

+}

+

+(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))))))