From: "川幡 太一" <kawabata.taichi@gmail.com> ( Taichi KAWABATA )
To: Kenichi Handa <handa@m17n.org>
Cc: Stefan Monnier <monnier@iro.umontreal.ca>, emacs-devel@gnu.org
Subject: Re: normalize.el
Date: Sun, 19 Apr 2009 04:06:30 +0900 [thread overview]
Message-ID: <877i1hzsqx.fsf%kawabata.taichi@gmail.com> (raw)
In-Reply-To: E1LrQVa-0003Qz-Er@etlken
Dear sirs,
>> In <E1LrQVa-0003Qz-Er@etlken>,
>> 半田さん wrote:
> In article <jwv1vsb89au.fsf-monnier+emacs@gnu.org>, Stefan Monnier <monnier@iro.umontreal.ca> writes:
> > > The attached is an Unicode normalization tool contributed by
> > > Kawabata-san. It performs all the Unicode normalization
> > > NFC/NFD/NFKD/NFKC, and provides a coding system utf-8-hfs
> > > that is suitable to be used for Mac OS 8.1's file names.
> > Great. Please rename it to uni-normalize.el or ucs-normalize.el.
> I renamed it to ucs-normalize.el and changed
> variable/function names as attached. But, byte-compiling
> shows these warnings and error. As the original
> normalize.el causes the same error, Kawabata-san, could you
> please fix it.
I'm sorry for late reply. Here is fixed version I tried to remove all
warnings. I believe this version fully passes `NormalizationTest-5.1.0.txt'.
However, it takes somewhat longer time for byte-compilation (About 1 min
for my 2GHz machine), and byte-compiled code will be quite larger than
original code.
These problems would be reduced if we could provide specifically
customized codes for Hangual character decompositions.
Note that HFS-NFD/HFS-NFC is prepared for `MacOS X' file names. While
UCS Normalization may remove stylistic and other infomations for CJK
Ideographs, Apple Normalization preserve them. (Equivalence test for
CJK Ideographs may need other schemes anyway).
====================================================================
;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC
;; Copyright (C) 2009
;; Free Software Foundation, Inc.
;; Author: Taichi Kawabata <kawabata.taichi@gmail.com>
;; Keywords: unicode, normalization
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; This program has passed the NormalizationTest-4.1.0.txt.
;;
;; References:
;; http://www.unicode.org/reports/tr15/
;; http://www.unicode.org/review/pr-29.html
;;
;; HFS-Normalization:
;; Reference:
;; http://developer.apple.com/technotes/tn/tn1150.html
;;
;; HFS Normalization excludes following area for decomposition.
;;
;; U+02000 .. U+02FFF :: Punctuation, symbols, dingbats, arrows, etc.
;; (Characters in this region will be composed.)
;; U+0F900 .. U+0FAFF :: CJK compatibility Ideographs.
;; U+2F800 .. U+2FFFF :: CJK compatibility Ideographs.
;;
;; HFS-Normalization is useful for normalizing text involving CJK Ideographs.
;;
;;;
;;; Implementation Notes on NFC/HFS-NFC.
;;;
;;
;; <Stages> Decomposition Composition
;; NFD: 'nfd nil
;; NFC: 'nfd t
;; NFKD: 'nfkd nil
;; NFKC: 'nfkd t
;; HFS-NFD: 'hfs-nfd 'hfs-nfd-comp-p
;; HFS-NFC 'hfs-nfd t
;;
;; Algorithm for Normalization
;;
;; Before normalization, following data will be prepared.
;;
;; 1. quick-check-list
;;
;; `quick-check-list' consists of characters that will be decomposed
;; during normalization. It includes composition-exclusions,
;; singletons, non-starter-decompositions and decomposable
;; characters.
;;
;; `quick-check-regexp' will search the above characters plus
;; combining characters.
;;
;; 2. decomposition-translation
;;
;; `decomposition-translation' is a translation table that will be
;; used to decompose the characters.
;;
;;
;; Normalization Process
;;
;; A. Searching (`ucs-normalize-region')
;;
;; Region is searched for `quick-check-regexp' to find possibly
;; normalizable point.
;;
;; B. Identification of Normalization Block
;;
;; (1) start of the block
;; If the searched character is in quick-check-list, then the
;; beginning of the block is the searched character.
;; If searched character is combining character, then previous
;; character will be the target character
;; (2) end of the block
;; Block ends at non-composable starter character.
;;
;; C. Decomposition (`ucs-normalize-block')
;;
;; The entire block will be decomposed by
;; `decomposition-translation' table.
;;
;; D. Sorting and Composition of Smaller Blocks (`ucs-normalize-block-compose-chars')
;;
;; The block will be split to multiple samller blocks by starter
;; charcters. Each block is sorted, and composed if necessary.
;;
;; E. Composition of Entire Block (`ucs-normalize-compose-chars')
;;
;; Composed blocks are collected and again composed.
;;; Code:
(eval-when-compile (require 'cl))
(eval-when-compile
(defconst ucs-normalize-composition-exclusions
'(#x0958 #x0959 #x095A #x095B #x095C #x095D #x095E #x095F
#x09DC #x09DD #x09DF #x0A33 #x0A36 #x0A59 #x0A5A #x0A5B
#x0A5E #x0B5C #x0B5D #x0F43 #x0F4D #x0F52 #x0F57 #x0F5C
#x0F69 #x0F76 #x0F78 #x0F93 #x0F9D #x0FA2 #x0FA7 #x0FAC
#x0FB9 #xFB1D #xFB1F #xFB2A #xFB2B #xFB2C #xFB2D #xFB2E
#xFB2F #xFB30 #xFB31 #xFB32 #xFB33 #xFB34 #xFB35 #xFB36
#xFB38 #xFB39 #xFB3A #xFB3B #xFB3C #xFB3E #xFB40 #xFB41
#xFB43 #xFB44 #xFB46 #xFB47 #xFB48 #xFB49 #xFB4A #xFB4B
#xFB4C #xFB4D #xFB4E #x2ADC #x1D15E #x1D15F #x1D160 #x1D161
#x1D162 #x1D163 #x1D164 #x1D1BB #x1D1BC #x1D1BD #x1D1BE
#x1D1BF #x1D1C0)
"Composition Exclusion List.
This list is taken from
http://www.unicode.org/Public/UNIDATA/CompositionExclusions-5.1.0.txt")
;; Unicode ranges that decompositions & combinings are defined.
(defvar check-range
'((#x00a0 . #x3400) (#xA600 . #x10fff) (#x1d000 . #x1dfff) (#x2f800 . #x2faff)))
;; Basic normalization functions
(defun nfd (char)
(let ((decomposition
(get-char-code-property char 'decomposition)))
(if (and decomposition (numberp (car decomposition)))
decomposition)))
(defun nfkd (char)
(let ((decomposition
(get-char-code-property char 'decomposition)))
(if (symbolp (car decomposition)) (cdr decomposition)
decomposition)))
(defun hfs-nfd (char)
(when (or (and (>= char 0) (< char #x2000))
(and (>= char #x3000) (< char #xf900))
(and (>= char #xfb00) (< char #x2f800))
(>= char #x30000))
(nfd char))))
(defun ucs-normalize-hfs-nfd-comp-p (char)
(and (>= char #x2000) (< char #x3000)))
(defsubst ucs-normalize-ccc (char)
(get-char-code-property char 'canonical-combining-class))
;; Data common to all normalizations
(eval-when-compile
(defvar combining-chars nil)
(defvar decomposition-pair-to-composition nil)
(defvar non-starter-decompositions nil)
(let ((char 0) ccc decomposition)
(mapc
(lambda (start-end)
(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 ccc (/= 0 ccc)) (add-to-list 'combining-chars char))
(if (and (numberp (car decomposition))
(/= (ucs-normalize-ccc (car decomposition))
0))
(add-to-list 'non-starter-decompositions char))
(when (numberp (car decomposition))
(if (and (= 2 (length decomposition))
(null (memq char ucs-normalize-composition-exclusions))
(null (memq char non-starter-decompositions)))
(setq decomposition-pair-to-composition
(cons (cons decomposition char)
decomposition-pair-to-composition)))
;; If not singleton decomposition, second and later characters in
;; decomposition will be the subject of combining characters.
(if (cdr decomposition)
(dolist (char (cdr decomposition))
(add-to-list 'combining-chars char))))))
check-range)))
(defun ucs-normalize-make-hash-table-from-alist (alist)
(let ((table (make-hash-table :test 'equal :size 2000)))
(mapc (lambda (x) (puthash (car x) (cdr x) table)) alist)
table))
(defvar ucs-normalize-decomposition-pair-to-primary-composite nil
"Hashtable of decomposed pair to primary composite.")
(setq ucs-normalize-decomposition-pair-to-primary-composite
(ucs-normalize-make-hash-table-from-alist
(eval-when-compile decomposition-pair-to-composition)))
(defun ucs-normalize-primary-composite (decomposition-pair composition-predicate)
(let ((char (gethash decomposition-pair
ucs-normalize-decomposition-pair-to-primary-composite)))
(if (and char
(functionp composition-predicate)
(null (funcall composition-predicate char)))
nil char)))
(defvar ucs-normalize-combining-chars nil)
(setq ucs-normalize-combining-chars (eval-when-compile combining-chars))
(defvar ucs-normalize-combining-chars-regexp nil
"Regular expression to match sequence of combining characters.")
(setq ucs-normalize-combining-chars-regexp
(eval-when-compile (concat (regexp-opt (mapcar 'char-to-string combining-chars)) "+")))
(eval-when-compile
(defun decomposition-translation-alist (decomposition-function)
(let (decomposition alist)
(mapc
(lambda (start-end)
(do ((char (car start-end) (+ char 1))) ((> char (cdr start-end)))
(setq decomposition (funcall decomposition-function char))
(if decomposition
(setq alist (cons (cons char
(apply 'append
(mapcar (lambda (x)
(decomposition-char-recursively
x decomposition-function))
decomposition)))
alist)))))
check-range)
alist))
(defun decomposition-char-recursively (char decomposition-function)
(let ((decomposition (funcall decomposition-function char)))
(if decomposition
(apply 'append
(mapcar (lambda (x)
(decomposition-char-recursively x decomposition-function))
decomposition))
(list char))))
(defun alist-list-to-vector (alist)
(mapcar (lambda (x) (cons (car x) (apply 'vector (cdr x)))) alist))
(defvar nfd-alist (alist-list-to-vector (decomposition-translation-alist 'nfd)))
(defvar nfkd-alist (alist-list-to-vector (decomposition-translation-alist 'nfkd)))
(defvar hfs-nfd-alist (alist-list-to-vector (decomposition-translation-alist 'hfs-nfd)))
)
(define-translation-table 'ucs-normalize-nfd-table
(make-translation-table-from-alist (eval-when-compile nfd-alist)))
(define-translation-table 'ucs-normalize-nfkd-table
(make-translation-table-from-alist (eval-when-compile nfkd-alist)))
(define-translation-table 'ucs-normalize-hfs-nfd-table
(make-translation-table-from-alist (eval-when-compile hfs-nfd-alist)))
(defun ucs-normalize-sort (chars)
"Sort by canonical combining class of chars."
(sort chars
(lambda (ch1 ch2)
(< (ucs-normalize-ccc ch1) (ucs-normalize-ccc ch2)))))
(defun ucs-normalize-compose-chars (chars composition-predicate)
"Compose CHARS by COMPOSITION-PREDICATE.
CHARS must be sorted and normalized in starter-combining pairs."
(if composition-predicate
(let* ((starter (car chars))
remain result prev-ccc
(target-chars (cdr chars))
target target-ccc
primary-composite)
(while target-chars
(setq target (car target-chars)
target-ccc (ucs-normalize-ccc target))
(if (and (or (null prev-ccc)
(< prev-ccc target-ccc))
(setq primary-composite
(ucs-normalize-primary-composite (list starter target)
composition-predicate)))
;; case 1: composable
(setq starter primary-composite
prev-ccc nil)
(if (= 0 target-ccc)
;; case 2: move starter
(setq result (append result (cons starter (nreverse remain)))
starter target
remain nil)
;; case 3: move target
(setq prev-ccc target-ccc
remain (cons target remain))))
(setq target-chars (cdr target-chars)))
(append result (cons starter (nreverse remain))))
chars))
(defun ucs-normalize-block-compose-chars (chars composition-predicate)
"Try composing CHARS by COMPOSITION-PREDICATE.
If COMPOSITION-PREDICATE is not given, then do nothing."
(let ((chars (ucs-normalize-sort chars)))
(if composition-predicate
(ucs-normalize-compose-chars chars composition-predicate)
chars)))
(eval-when-compile
(defun quick-check-list (decomposition-translation
&optional composition-predicate)
"Quick-Check List for DECOMPOSITION-TRANSLATION and COMPOSITION-PREDICATE.
It includes Singletons, CompositionExclusions, and Non-Starter
decomposition. "
(let (entries decomposition composition)
(mapc
(lambda (start-end)
(do ((i (car start-end) (+ i 1))) ((> i (cdr start-end)))
(setq decomposition
(string-to-list
(translate-string (char-to-string i) decomposition-translation)))
(setq composition
(ucs-normalize-block-compose-chars decomposition composition-predicate))
(when (not (equal composition (list i)))
(setq entries (cons i entries)))))
check-range)
;;(remove-duplicates
(append entries
ucs-normalize-composition-exclusions
non-starter-decompositions)))
;;)
(defvar nfd-quick-check-list (quick-check-list 'ucs-normalize-nfd-table ))
(defvar nfc-quick-check-list (quick-check-list 'ucs-normalize-nfd-table t ))
(defvar nfkd-quick-check-list (quick-check-list 'ucs-normalize-nfkd-table ))
(defvar nfkc-quick-check-list (quick-check-list 'ucs-normalize-nfkd-table t ))
(defvar hfs-nfd-quick-check-list (quick-check-list 'ucs-normalize-hfs-nfd-table
'ucs-normalize-hfs-nfd-comp-p))
(defvar hfs-nfc-quick-check-list (quick-check-list 'ucs-normalize-hfs-nfd-table t ))
(defun quick-check-list-to-regexp (quick-check-list)
(regexp-opt (mapcar 'char-to-string (append quick-check-list combining-chars))))
)
;; NFD/NFC
(defvar ucs-normalize-nfd-quick-check-regexp nil)
(setq ucs-normalize-nfd-quick-check-regexp
(eval-when-compile (quick-check-list-to-regexp nfd-quick-check-list)))
(defvar ucs-normalize-nfc-quick-check-regexp nil)
(setq ucs-normalize-nfc-quick-check-regexp
(eval-when-compile (quick-check-list-to-regexp nfc-quick-check-list)))
;; NFKD/NFKC
(defvar ucs-normalize-nfkd-quick-check-regexp nil)
(setq ucs-normalize-nfkd-quick-check-regexp
(eval-when-compile (quick-check-list-to-regexp nfkd-quick-check-list)))
(defvar ucs-normalize-nfkc-quick-check-regexp nil)
(setq ucs-normalize-nfkc-quick-check-regexp
(eval-when-compile (quick-check-list-to-regexp nfkc-quick-check-list)))
;; HFS-NFD/HFS-NFC
(defvar ucs-normalize-hfs-nfd-quick-check-regexp nil)
(setq ucs-normalize-hfs-nfd-quick-check-regexp
(eval-when-compile (quick-check-list-to-regexp hfs-nfd-quick-check-list)))
(defvar ucs-normalize-hfs-nfc-quick-check-regexp nil)
(setq ucs-normalize-hfs-nfc-quick-check-regexp
(eval-when-compile (quick-check-list-to-regexp hfs-nfc-quick-check-list)))
;;------------------------------------------------------------------------------------------
;; Normalize local region.
(defun ucs-normalize-block
(from to &optional decomposition-translation-table composition-predicate)
"Normalize region FROM TO, by sorting the region with canonical-cc.
If DECOMPOSITION-TRANSLATION-TABLE is given, translate region
before sorting. If COMPOSE is t and COMPOSITION-PREDICATE is
given, then compose the region by using it."
(save-restriction
(narrow-to-region from to)
(goto-char (point-min))
(if decomposition-translation-table
(translate-region from to decomposition-translation-table))
(goto-char (point-min))
(let ((start (point)) chars); ccc)
(while (not (eobp))
(forward-char)
(when (or (eobp)
(= 0 (ucs-normalize-ccc (char-after (point)))))
(setq chars
(nconc chars
(ucs-normalize-block-compose-chars
(string-to-list (buffer-substring start (point)))
composition-predicate))
start (point)))
;;(unless ccc (error "Undefined character can not be normalized!"))
)
(delete-region (point-min) (point-max))
;; (message "debug chars=%s" chars)
(apply 'insert
(ucs-normalize-compose-chars
chars composition-predicate)))))
(defun ucs-normalize-region
(from to quick-check-regexp translation-table composition-predicate)
"Normalize region from FROM to TO.
QUICK-CHECK-REGEXP is applied for searching the region.
TRANSLATION-TABLE will be used to decompose region.
COMPOSITION-PREDICATE will be used to compose region."
(save-excursion
(save-restriction
(narrow-to-region from to)
(goto-char (point-min))
(let (start-pos starter)
(while (re-search-forward quick-check-regexp nil t)
(setq starter (string-to-char (match-string 0)))
(setq start-pos (match-beginning 0))
(ucs-normalize-block
;; from
(if (or (= start-pos (point-min))
(and (= 0 (ucs-normalize-ccc starter))
(not (memq starter ucs-normalize-combining-chars))))
start-pos (1- start-pos))
;; to
(if (looking-at ucs-normalize-combining-chars-regexp)
(match-end 0) (1+ start-pos))
translation-table composition-predicate))))))
;; --------------------------------------------------------------------------------
(defmacro ucs-normalize-string (ucs-normalize-region)
`(with-temp-buffer
(insert str)
(,ucs-normalize-region (point-min) (point-max))
(buffer-string)))
;;;###autoload
(defun ucs-normalize-NFD-region (from to)
"Normalize the current region by the Unicode NFD."
(interactive "r")
(ucs-normalize-region from to
ucs-normalize-nfd-quick-check-regexp
'ucs-normalize-nfd-table nil))
;;;###autoload
(defun ucs-normalize-NFD-string (str)
"Normalize the string STR by the Unicode NFD."
(ucs-normalize-string ucs-normalize-NFD-region))
;;;###autoload
(defun ucs-normalize-NFC-region (from to)
"Normalize the current region by the Unicode NFC."
(interactive "r")
(ucs-normalize-region from to
ucs-normalize-nfc-quick-check-regexp
'ucs-normalize-nfd-table t))
;;;###autoload
(defun ucs-normalize-NFC-string (str)
"Normalize the string STR by the Unicode NFC."
(ucs-normalize-string ucs-normalize-NFC-region))
;;;###autoload
(defun ucs-normalize-NFKD-region (from to)
"Normalize the current region by the Unicode NFKD."
(interactive "r")
(ucs-normalize-region from to
ucs-normalize-nfkd-quick-check-regexp
'ucs-normalize-nfkd-table nil))
;;;###autoload
(defun ucs-normalize-NFKD-string (str)
"Normalize the string STR by the Unicode NFKD."
(ucs-normalize-string ucs-normalize-NFKD-region))
;;;###autoload
(defun ucs-normalize-NFKC-region (from to)
"Normalize the current region by the Unicode NFKC."
(interactive "r")
(ucs-normalize-region from to
ucs-normalize-nfkc-quick-check-regexp
'ucs-normalize-nfkd-table t))
;;;###autoload
(defun ucs-normalize-NFKC-string (str)
"Normalize the string STR by the Unicode NFKC."
(ucs-normalize-string ucs-normalize-NFKC-region))
;;;###autoload
(defun ucs-normalize-HFS-NFD-region (from to)
"Normalize the current region by the Unicode NFD and Mac OS's HFS Plus."
(interactive "r")
(ucs-normalize-region from to
ucs-normalize-hfs-nfd-quick-check-regexp
'ucs-normalize-hfs-nfd-table
'ucs-normalize-hfs-nfd-comp-p))
;;;###autoload
(defun ucs-normalize-HFS-NFD-string (str)
"Normalize the string STR by the Unicode NFD and Mac OS's HFS Plus."
(ucs-normalize-string ucs-normalize-HFS-NFD-region))
;;;###autoload
(defun ucs-normalize-HFS-NFC-region (from to)
"Normalize the current region by the Unicode NFC and Mac OS's HFS Plus."
(interactive "r")
(ucs-normalize-region from to
ucs-normalize-hfs-nfc-quick-check-regexp
'ucs-normalize-hfs-nfd-table t))
;;;###autoload
(defun ucs-normalize-HFS-NFC-string (str)
"Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus."
(ucs-normalize-string ucs-normalize-HFS-NFC-region))
;; Post-read-conversion function for `utf-8-hfs'.
(defun ucs-normalize-hfs-nfd-post-read-conversion (len)
(save-excursion
(save-restriction
(narrow-to-region (point) (+ (point) len))
(let ((buffer-modified-p (buffer-modified-p)))
(ucs-normalize-HFS-NFC-region (point-min) (point-max))
(- (point-max) (point-min))))))
;;; coding-system definition
(define-coding-system 'utf-8-hfs
"UTF-8 base coding system with normalization on decoding.
The singleton characters in HFS normalization exclusion will not
be decomposed. It doesn't perform normalization on encoding."
:coding-type 'utf-8
:mnemonic ?U
:charset-list '(unicode)
;; :decode-translation-table (not necessary)
:post-read-conversion 'ucs-normalize-hfs-nfd-post-read-conversion
;; NFD encoder is not necessary because MacOS will automatically do it.
;; :encode-translation-table 'nfd-encode-translation-table
;; :pre-write-conversion 'nfd-encode-function
)
;;; ucs-normalize.el ends here
--
---------------------------------------------------------------------
kawabata.taichi@gmail.com KAWABATA, Taichi
next prev parent reply other threads:[~2009-04-18 19:06 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
2009-04-02 6:40 normalize.el Kenichi Handa
2009-04-02 8:10 ` normalize.el Kim F. Storm
2009-04-02 11:54 ` normalize.el Kenichi Handa
2009-04-02 16:49 ` normalize.el Stefan Monnier
2009-04-08 5:39 ` normalize.el Kenichi Handa
2009-04-18 19:06 ` 川幡 太一 [this message]
2009-04-19 3:39 ` normalize.el 川幡 太一
2009-04-21 2:15 ` normalize.el Kenichi Handa
2009-04-21 17:10 ` normalize.el 川幡 太一
2009-04-03 9:10 ` normalize.el Richard M Stallman
2009-04-03 13:24 ` normalize.el Stefan Monnier
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=877i1hzsqx.fsf%kawabata.taichi@gmail.com \
--to=kawabata.taichi@gmail.com \
--cc=emacs-devel@gnu.org \
--cc=handa@m17n.org \
--cc=monnier@iro.umontreal.ca \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.