+#+darwin

+(defvar *enable-darwin-path-normalization* nil

+  "When non-NIL, pathnames are on Darwin are normalized when created.

+  Otherwise, the pathnames are unchanged.

+

+  This must be NIL during bootstrapping because Unicode is not yet

+  available.")

+

+      #-darwin

+      (%make-pathname host device directory name type version)

+      #+darwin

+      (flet ((normalize-name (piece)

+	       ;; Normalize Darwin pathnames by converting Hangul

+	       ;; syllables to conjoining jamo, and converting the

+	       ;; string to NFD form, but skipping over a range of

+	       ;; characters.

+	       (typecase piece

+		 (string

+		  (if *enable-darwin-path-normalization*

+		      (decompose (unicode::decompose-hangul piece)

+				 :compatibility nil

+				 :darwinp t)

+		      piece))

+		 (t

+		  ;; What should we do about lisp::pattern objects

+		  ;; that occur in the name component?

+		  piece))))

+	(%make-pathname host device

+			(mapcar #'normalize-name directory)

+			(normalize-name name)

+			(normalize-name type)

+			version))))

+		                 #+:executable

+(defun decompose (string &key (compatibility t) (start 0) end darwinp)

+  "Convert STRING to NFD (or NFKD).  If :darwinp is non-NIL, then

+  characters in the ranges U2000-U2FFF, UF900-UFA6A, and U2F800-U2FA1D

+  are not decomposed, as specified for Darwin pathnames."

+		   (if (and darwinp

+			    (or (<= #x2000 code #x2fff)

+				(<= #xf900 code #xfa6a)

+				(<= #x2f800 code #x2fa1d)))

+		       (out code)

+		       (let ((decomp (unicode-decomp code compatibility)))

+			 (if decomp (rec decomp 0 (length decomp)) (out code)))))))

+      (with-one-string string start end offset-var

+  (decompose string :compatibility nil))

+  (decompose string :compatibility t))

+

+

+(defun decompose-hangul-syllable (cp stream)

+  "Decompose the Hangul syllable codepoint CP to an equivalent sequence

+  of conjoining jamo and print the decomposed result to the stream

+  STREAM."

+  (let* ((s-base #xac00)

+	 (l-base #x1100)

+	 (v-base #x1161)

+	 (t-base #x11a7)

+	 (v-count 21)

+	 (t-count 28)

+	 (n-count (* v-count t-count)))

+    ;; Step 1: Compute index of the syllable S

+    (let ((s-index (- cp s-base)))

+      ;; Step 2: If s is in the range 0 <= s <= s-count, the compute

+      ;; the components.

+      (let ((l (+ l-base (truncate s-index n-count)))

+	    (v (+ v-base (truncate (mod s-index n-count) t-count)))

+	    (tt (+ t-base (mod s-index t-count))))

+	;; Step 3: If tt = t-base, then there is no trailing character

+	;; so replace s by the sequence <l,v>.  Otherwise there is a

+	;; trailing character, so replace s by the sequence <l,v,tt>.

+	(princ (code-char l) stream)

+	(princ (code-char v) stream)

+	(unless (= tt t-base)

+	  (princ (code-char tt) stream)))))

+  (values))

+

+(defun is-hangul-syllable (codepoint)

+  "Test if CODEPOINT is a Hangul syllable"

+  (let* ((s-base #xac00)

+	 (l-count 19)

+	 (v-count 21)

+	 (t-count 28)

+	 (n-count (* v-count t-count))

+	 (number-of-syllables (* l-count n-count)))

+    (<= 0 (- codepoint s-base) number-of-syllables)))

+

+(defun decompose-hangul (string)

+  "Decompose any Hangul syllables in STRING to an equivalent sequence of

+  conjoining jamo characters."

+  (with-output-to-string (s)

+    (loop for cp being the codepoints of string

+	  do

+	     (if (is-hangul-syllable cp)

+		 (decompose-hangul-syllable cp s)

+		 (multiple-value-bind (high low)

+		     (surrogates cp)

+		   (princ high s)

+		   (when low

+		     (princ low s)))))))

+    * The default external format is `:utf-8` instead of `:iso8859-1`.

+    * ~~#68~~ gcc8.1.1 can't build lisp.  Change optimization from `-O2` to `-O1`.

+    * ~~#72~~ CMU user manual now part of cmucl-site.

+    * ~~#73~~ Update clx from upstream clx.

+    * ~~#77~~ Added tests for sqrt for exceptional values.

+    * ~~#81~~ Added contribs from Eric Marsden.

+    * ~~#82~~ Replace bc with expr in GNUMakefile.

+    * ~~#86~~ Building with gcc 8 and later works when using -O2 optimization.

+    * ~~#91~~ Loop destructuring no longer incorrectly signals an error.

+    * ~~#95~~ Disassembler syntax of x86 je and movzx is incorrect.

+    * ~~#98~~ fstpd is not an Intel instruction; disassemble as `fstp dword ptr [addr]`.

+    * ~~#103~~ RANDOM-MT19937-UPDATE assembly routine still exists.

+    * ~~#107~~ Replace u_int8_t with uint8_t.

+    * ~~#108~~ Update ASDF.

+    * ~~#112~~ CLX can't connect to X server via inet sockets.

+    * ~~#120~~ `SOFTWARE-VERSION` is implemented in C.

+    * ~~#128~~ `QUIT` accepts an exit code.

+    * ~~#130~~ Move file-author to C.

+    * ~~#132~~ Ansi test `RENAME-FILE.1` no longer 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`; add alias for `:locale` external format.

+    * ~~#140~~ External format for streams that are not `file-stream`'s.

+    * ~~#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.

+    * ~~#150~~ Add aliases for external format cp949 and euckr.

+    * ~~#152~~ Add new external format, `:locale` as an alias to the codeset from LANG and friends.

+    * ~~#!53~~ Terminals default to an encoding of `:locale`.

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

+    * ~~#157~~ `(directory "foo/**/")` only returns directories now.

+    * #158 Darwin uses utf-8, but we don't support all the rules for pathnames.

+    * ~~#162~~ `*filename-encoding*` defaults to `:null` to mean no encoding.

+    * ~~#163~~ Add command-line option `-version` and `--version` to get lisp version.

+    * ~~#165~~ Avoid inserting NIL into simple `LOOP` from `FORMAT`.

+    * ~~#166~~ Fix incorrect type declaration for exponent from `integer-decode-float`.

+    * ~~#168~~ Don't use negated forms for jmp instructions when possible.

+    * ~~#169~~ Add pprinter for `define-vop` and `sc-case`.

+    * ~~#173~~ Add pprinter for `define-assembly-routine`.

+    * ~~#177~~ Add pprinter for `deftransform` and `defoptimizer`.

+#: src/code/string.lisp

+msgid ""

+"Convert String to NFD (or NFKD).  If :darwinp is non-NIL, then\n"

+"    characters in the ranges U2000-U2FFF, UF900-UFA6A, and\n"

+"    U2F800-U2FA1D are not decomposed, as specified for Darwin\n"

+"    pathnames."

+msgstr ""

+

+#: src/code/unicode.lisp

+msgid ""

+"Decompose the Hangul syllable codepoint CP to an equivalent sequence\n"

+"  of conjoining jamo and print the decomposed result to the stream\n"

+"  STREAM."

+msgstr ""

+

+#: src/code/unicode.lisp

+msgid "Test if CODEPOINT is a Hangul syllable"

+msgstr ""

+

+#: src/code/unicode.lisp

+msgid ""

+"Decompose any Hangul syllables in STRING to an equivalent sequence of\n"

+"  conjoining jamo characters."

+msgstr ""

+

+(define-test issue.158

+    (:tag :issues)

+  (let* ((name (string #\Hangul_Syllable_Gyek))

+	 (path (make-pathname :directory (list :relative name)

+			      :name name

+			      :type name)))

+    ;; Enable this when we implement normalization for Darwin

+    #+(and nil darwin)

+    (let ((expected '(4352 4456 4543)))

+      ;; Tests that on Darwin the Hangul pathname has been normalized

+      ;; correctly.  We fill in the directory, name, and type components

+      ;; with the same thing since it shouldn't really matter.

+      ;;

+      ;; The expected value is the conjoining jamo for the character

+      ;; #\Hangul_Syllable_Gyek.

+      (assert-equal (map 'list #'char-code (second (pathname-directory path)))

+		    expected)

+      (assert-equal (map 'list #'char-code (pathname-name path))

+		    expected)

+      (assert-equal (map 'list #'char-code (pathname-type path))

+		    expected))

+    #-darwin

+    (let ((expected (list (char-code #\Hangul_Syllable_Gyek))))

+      ;; For other OSes, just assume that the pathname is unchanged.

+      (assert-equal (map 'list #'char-code (second (pathname-directory path)))

+		    expected)

+      (assert-equal (map 'list #'char-code (pathname-name path))

+		    expected)

+      (assert-equal (map 'list #'char-code (pathname-type path))

+		    expected))))

+

+(define-test issue.158.dir

+    (:tag :issues)

+  (flet ((get-file ()

+	   ;; This assumes that there is only one file in resources/darwin

+	   (let ((files (directory (merge-pathnames "resources/darwin/*.txt" *test-path*))))

+	     (assert-equal (length files) 1)

+	     (first files))))

+    (let ((f (get-file))

+	  (expected-name "안녕하십니까"))

+      #+darwin

+      (assert-equal (pathname-name f)

+		    (unicode::decompose-hangul expected-name))

+      #-darwin

+      (assert-equal (pathname-name f) expected-name))))

+    

+

+

+The file name of this file is "안녕하십니까.txt" ("Hello" in Korean.)

+

+