]> code.delx.au - gnu-emacs/blobdiff - lisp/international/ucs-normalize.el
Update copyright year to 2015
[gnu-emacs] / lisp / international / ucs-normalize.el
index f83e0f7588f6d1e91ee41e2b0a44f9b2fb7e1a68..8839b00dfff54b77e0cd4a6abc503db4f304aaa3 100644 (file)
@@ -1,6 +1,6 @@
 ;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC
 
-;; Copyright (C) 2009-201 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
 
 ;; Author: Taichi Kawabata <kawabata.taichi@gmail.com>
 ;; Keywords: unicode, normalization
 
 (defconst ucs-normalize-version "1.2")
 
-(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cl-lib))
 
 (declare-function nfd "ucs-normalize" (char))
 
   This list is taken from
     http://www.unicode.org/Public/UNIDATA/5.2/CompositionExclusions.txt")
 
-  ;; Unicode ranges that decompositions & combinings are defined.
+  ;; Unicode ranges that decompositions & combining characters are defined.
   (defvar check-range nil)
     (setq check-range '((#x00a0 . #x3400) (#xA600 . #xAC00) (#xF900 . #x110ff) (#x1d000 . #x1dfff) (#x1f100 . #x1f2ff) (#x2f800 . #x2faff)))
 
   (defun nfd (char)
     (let ((decomposition
            (get-char-code-property char 'decomposition)))
-      (if (and decomposition (numberp (car decomposition)))
+      (if (and decomposition (numberp (car decomposition))
+              (or (> (length decomposition) 1)
+                  (/= (car decomposition) char)))
           decomposition)))
 
   (defun nfkd (char)
     (let ((decomposition
            (get-char-code-property char 'decomposition)))
       (if (symbolp (car decomposition)) (cdr decomposition)
-        decomposition)))
+        (if (or (> (length decomposition) 1)
+               (/= (car decomposition) char)) decomposition))))
 
   (defun hfs-nfd (char)
     (when (or (and (>= char 0) (< char #x2000))
   (let ((char 0) ccc decomposition)
     (mapc
      (lambda (start-end)
-       (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
+       (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
          (setq ccc (ucs-normalize-ccc char))
          (setq decomposition (get-char-code-property
                               char 'decomposition))
+        (if (and (= (length decomposition) 1)
+                 (= (car decomposition) char))
+            (setq decomposition nil))
          (if (and ccc (/= 0 ccc)) (add-to-list 'combining-chars char))
          (if (and (numberp (car decomposition))
                   (/= (ucs-normalize-ccc (car decomposition))
@@ -221,7 +227,7 @@ Note that Hangul are excluded.")
          (eval-when-compile decomposition-pair-to-composition)))
 
 (defun ucs-normalize-primary-composite (decomposition-pair composition-predicate)
-  "Convert DECOMPOSITION-PAIR to primay composite using COMPOSITION-PREDICATE."
+  "Convert DECOMPOSITION-PAIR to primary composite using COMPOSITION-PREDICATE."
   (let ((char (or (gethash decomposition-pair
                            ucs-normalize-decomposition-pair-to-primary-composite)
                   (and (<= #x1100 (car decomposition-pair))
@@ -264,7 +270,7 @@ Note that Hangul are excluded.")
     (let (decomposition alist)
       (mapc
        (lambda (start-end)
-         (do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
+         (cl-do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
            (setq decomposition (funcall decomposition-function char))
            (if decomposition
                (setq alist (cons (cons char
@@ -385,7 +391,7 @@ decomposition."
     (let (entries decomposition composition)
       (mapc
        (lambda (start-end)
-         (do ((i (car start-end) (+ i 1))) ((> i (cdr start-end)))
+         (cl-do ((i (car start-end) (+ i 1))) ((> i (cdr start-end)))
            (setq decomposition
                  (string-to-list
                   (with-temp-buffer