;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC
-;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2016 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))
(setq decomposition-pair-to-composition nil)
(defvar non-starter-decompositions nil)
(setq non-starter-decompositions nil)
+ ;; This file needs to access these 2 Unicode properties, but when we
+ ;; compile it during bootstrap, charprop.el was not built yet, and
+ ;; therefore is not yet loaded into bootstrap-emacs, so
+ ;; char-code-property-alist is nil, and get-char-code-property
+ ;; always returns nil, something the code here doesn't like.
+ (define-char-code-property 'decomposition "uni-decomposition.el")
+ (define-char-code-property 'canonical-combining-class "uni-combining.el")
(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))
(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))
(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
(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
:pre-write-conversion 'ucs-normalize-hfs-nfd-pre-write-conversion
)
+;; This is tested in dired.c:file_name_completion in order to reject
+;; false positives due to comparison of encoded file names.
+(coding-system-put 'utf-8-hfs 'decomposed-characters 't)
+
(provide 'ucs-normalize)
;; Local Variables: