[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: normalize.el

From: Kenichi Handa
Subject: Re: normalize.el
Date: Wed, 08 Apr 2009 14:39:34 +0900

In article <address@hidden>, Stefan Monnier <address@hidden> 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.

Compiling file /home/handa/ucs-normalize.el at Wed Apr  8 14:37:56 2009
Entering directory `/home/handa/'
ucs-normalize.el:187:46:Warning: assignment to free variable `combining-chars'
ucs-normalize.el:198:43:Warning: assignment to free variable
ucs-normalize.el:201:30:Warning: assignment to free variable
ucs-normalize.el:202:30:Warning: assignment to free variable `nfc-singletons'
ucs-normalize.el:203:30:Warning: assignment to free variable `nfd-alist'
ucs-normalize.el:206:30:Warning: assignment to free variable
ucs-normalize.el:207:30:Warning: assignment to free variable
ucs-normalize.el:208:30:Warning: assignment to free variable `hfs-nfd-alist'
ucs-normalize.el:191:19:Warning: assignment to free variable `nfkd-alist'
ucs-normalize.el:192:36:Warning: reference to free variable `nfkd-alist'
ucs-normalize.el:209:13:Warning: reference to free variable
ucs-normalize.el:205:12:Warning: reference to free variable `nfc-predicate'
ucs-normalize.el:205:12:Warning: reference to free variable `nfc-search-chars'
ucs-normalize.el:205:12:Warning: reference to free variable `nfc-singletons'
ucs-normalize.el:223:40:Warning: reference to free variable `nfd-alist'
ucs-normalize.el:223:40:Warning: reference to free variable
ucs-normalize.el:223:40:Warning: reference to free variable
ucs-normalize.el:223:40:Warning: reference to free variable
ucs-normalize.el:224:40:Warning: reference to free variable `hfs-nfd-alist'
ucs-normalize.el:225:4:Error: Symbol's value as variable is void: nfc-predicate

Kenichi Handa

;;; ucs-normalize.el --- Unicode normalization NFC/NFD/NFKD/NFKC

;; Copyright (C) 2009
;;   Free Software Foundation, Inc.

;; Author: Taichi Kawabata <address@hidden>
;; Maintainer: Taichi Kawabata <address@hidden>
;; 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
;; 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:

;; The following code will normalize the string or text according to
;; the NFC/NFD/NFKD (single step) NFKC (dual step).

;; This program has passed the NormalizationTest-4.1.0.txt except
;; Hangul normalizations.

;; References:
;; http://www.unicode.org/reports/tr15/
;; http://www.unicode.org/review/pr-29.html

;; Furthermore, it supports HFS normalization, for people who don't
;; want to normalize the CJK characters.

;;; Note on HFS Normalization.
;; HFS-Normalization is the way to normalize text, as described by HFS
;; Plus Volue format specification
;; (http://developer.apple.com/technotes/tn/tn1150.html).  This is
;; useful espcially for CJK people, since it doesn't normlize CJK
;; compatibility characters.
;; Normalization Exclusion Area:
;;  U+02000 .. U+02FFF :: Punctuation, symbols, dingbats, arrows, etc.
;;  U+0F900 .. U+0FAFF :: CJK compatibility Ideographs.
;;  U+2F800 .. U+2FFFF :: CJK compatibility Ideographs.

;;; Implementation Notes on NFC/HFS-NFC. (ccc = canonical combining class)
;; A. `re-search-forward' for the following characters.
;;   (1) characters that should be decomposed anyway.
;;   (1-a) composition-exclusion characters
;;   (1-b) singleton characters
;;   (1-c) characters whose decomposed first char does not have ccc=0.
;;   (2) characters that may appear as second of composed character.
;;   (2-a) character whose ccc != 0.
;;   (2-b) character whose ccc = 0.
;; B. In case of (1) in step A, translate character, go to the
;;    beginning position of translated region, and go back to step A.
;; C. In case of (2) in step A, normalize the block around the
;;    searched character.  (`normalize-block')
;;    (1) start of the block
;;        In case of (2-a) in step A, if the previous character
;;        exists, then the beginning of the block is the previous
;;        character.  In case of (2-b), if the previous character's
;;        ccc = 0, then the beginning of the block is the previous
;;        character.  Otherwise, the beginning of the block is the
;;        searched character.
;;    (2) end of the block
;;        from the searched character, the end of the block is
;;        searched until the character whose ccc=0.
;; D. Normalize the block
;;    (1) decompose the block
;;    (2) sort the combining characters
;;    (3) compose the block.

;;; Implementation Notes on NFD/HFS-NFD.
;; A. `re-search-forward' for the combining characters sequence.
;; B. Normalize the block around the searched character sequence.
;;    (1) Start of the block is the previous character if it exists.
;;        If not, start of the block is the searched character.
;;    (2) End of the block is the end of the combining character
;;        sequence.
;; C. Normalize the block
;;    (1) decompose the block
;;    (2) sort the combining characters
;; D. Translate all the rest at once.

;;; Implementation Notes on NFKC/NFKD
;; NFKC/NFKD is realized as applying NFC/NFD to the text which is
;; firstly translated by NFKD(-unique) decomposition patterns.

;;; Code:

(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 Table.
The table is taken from


  ;; generics
  (setq combining-chars nil)
  (setq decomp-pair-to-comp-hash (make-hash-table :test 'equal :size 2000)) ; 
1003 in Unicode 4.1.0 (except hangul)

  ;; NFC/NFD
  (defun nfc-predicate (char) t)
  (setq nfc-search-chars nil)
  (setq nfc-singletons nil)
  (setq nfd-alist nil)

  (defun hfs-nfc-predicate (char)
    (or (and (>= char 0) (< char #x2000))
             (and (>= char #x3000) (< char #xf900))
             (and (>= char #xfb00) (< char #x2f800))
             (>= char #x30000)))
  (setq hfs-nfc-search-chars nil)
  (setq hfs-nfc-singletons nil)
  (setq hfs-nfd-alist nil)

  (setq nfkd-alist nil)

  ;; macros
  (defmacro register-database (predicate 
    `(when (apply #',predicate (list char))
       (let ((decomp-1st-ccc
               (car decomposition) 'canonical-combining-class)))
         (setq ,decomposition-alist (cons (cons char (vconcat decomposition))
         (unless (memq char ucs-normalize-composition-exclusions)
           (if (= 1 (length decomposition))
               (setq ,singletons (cons char ,singletons))
             ;; add second char of decomposition for search-chars iff ccc = 0
             (if (= 0 (get-char-code-property (cadr decomposition)
                 (add-to-list ',search-chars (cadr decomposition))))
           ;; For fast normalization, the case of positive integer
           ;; `decomp-1st-ccc' means that the char should also be
           ;; considered as something like singleton.
           (if (and decomp-1st-ccc (/= 0 decomp-1st-ccc))
               (setq ,singletons (cons char ,singletons)))))))

  (let ((char 0) ccc decomposition)
    (while (< char #x30000) 
      (setq ccc (get-char-code-property
                 char 'canonical-combining-class))
      (setq decomposition (get-char-code-property 
                           char 'decomposition))
      ;; add all combining-char to fast search list.
      (if (and ccc (/= 0 ccc)) (add-to-list 'combining-chars char))
      (when decomposition
        (if (symbolp (car decomposition))
            ;; compatibiliy
            (setq nfkd-alist (cons (cons char (vconcat (cdr decomposition)))
          ;; canonical
          (setq nfkd-alist (cons (cons char (vconcat decomposition))
          (if (and (= 2 (length decomposition))
                   (null (memq char ucs-normalize-composition-exclusions)))
              (puthash decomposition char decomp-pair-to-comp-hash))
          ;; NFC/NFD
          (register-database nfc-predicate
          ;; HFS-NFC/HFS-NFD
          (register-database hfs-nfc-predicate
      (setq char (1+ char))))

  (defun normalize-repetitively-expand-alist (alist)
    (let ((flag t) elem hit)
      (while flag
        (setq flag nil)
        (dolist (entry alist)
          (setq elem (mapcar (lambda (x) 
                               (setq hit (assoc x alist))
                               (if hit (setq flag t))
                               (if hit (mapcar 'identity (cdr hit)) (list x)))
                             (cdr entry)))
          (if flag (setcdr entry (vconcat (apply 'append elem))))))))

  (normalize-repetitively-expand-alist nfd-alist)
  (normalize-repetitively-expand-alist hfs-nfd-alist)
  (normalize-repetitively-expand-alist nfkd-alist)


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

(defvar ucs-normalize-decomp-pair-to-comp-hash nil
  "Hashtable of decomposed pair to primary composite.")
  (setq ucs-normalize-decomp-pair-to-comp-hash
  (eval-when-compile decomp-pair-to-comp-hash))

(defvar ucs-normalize-nfc-search-regexp nil)
  (setq ucs-normalize-nfc-search-regexp
  (eval-when-compile (regexp-opt 
                      (append (mapcar 'char-to-string nfc-search-chars)
                              (mapcar 'char-to-string combining-chars)
                              (mapcar 'char-to-string 
                              (mapcar 'char-to-string nfc-singletons)))))
(defvar ucs-normalize-nfc-translation-chars nil)
  (setq ucs-normalize-nfc-translation-chars
  (eval-when-compile (append ucs-normalize-composition-exclusions 
(define-translation-table 'ucs-normalize-nfd-table 
  (eval-when-compile (make-translation-table-from-alist nfd-alist)))

(defvar ucs-normalize-hfs-nfc-search-regexp nil)
  (setq ucs-normalize-hfs-nfc-search-regexp
  (eval-when-compile (regexp-opt
                      (append (mapcar 'char-to-string hfs-nfc-search-chars)
                              (mapcar 'char-to-string combining-chars)
                              (mapcar 'char-to-string 
                              (mapcar 'char-to-string hfs-nfc-singletons)))))
(defvar ucs-normalize-hfs-nfc-translation-chars nil)
  (setq ucs-normalize-hfs-nfc-translation-chars
  (eval-when-compile (append ucs-normalize-composition-exclusions 
(define-translation-table 'ucs-normalize-hfs-nfd-table
  (eval-when-compile (make-translation-table-from-alist hfs-nfd-alist)))

(define-translation-table 'ucs-normalize-nfkd-table
  (eval-when-compile (make-translation-table-from-alist nfkd-alist)))


;; Normalize local region.
(defun ucs-normalize-block (from to &optional translation-table compose)
  ;; block-string = [starter?  diacritics+]
    (narrow-to-region from to)
    (goto-char (point-min))
    ;; decompose if needed.
    (if translation-table
        (translate-region from to translation-table))
    (let ((starter (char-after from)) diacritics)
      (if (= (get-char-code-property starter 'canonical-combining-class) 0)
          (setq diacritics (string-to-list (buffer-substring (1+ from) 
        (setq starter nil)
        (setq diacritics (string-to-list (buffer-substring from (point-max)))))
      ;; sort diacritical marks if needed.
      (if (< 1 (length diacritics))
          (setq diacritics
                (sort diacritics
                      (lambda (ch1 ch2)
                        (< (get-char-code-property ch1 
                           (get-char-code-property ch2 
      ;; compose if needed (and both starter and diacritics exists).
      (if (and compose (and starter diacritics))
          (let ((diac diacritics) prev (prev-ccc 0) ccc prim-comp)
            (while diac
              (setq ccc (get-char-code-property (car diac)
              (if (and (or (< prev-ccc ccc) (= ccc 0)) ;; e.g. #x09c7 #x09be -> 
                       (setq prim-comp (gethash (list starter (car diac))
                    (setq prev-ccc 0)
                    (setq starter prim-comp)
                    (if prev (setcdr prev (cdr diac)) (setq diacritics (cdr 
                    (setq diac diacritics))
                (setq prev-ccc ccc
                      prev diac
                      diac (cdr diac))))))
      ;; replace buffer
      (delete-region (point-min) (point-max))
      (insert (concat (if starter (list starter)) diacritics)))
    (point-max))) ;; return the last position.

(defun ucs-normalize-composition-region (from to regexp translation-table 
                                          &optional compat)
      (narrow-to-region from to)
      (if compat (translate-region from to 'ucs-normalize-nfkd-table))
      (goto-char (point-min))
      (let (start-pos starter)
        (while (re-search-forward regexp nil t)
          (setq starter (string-to-char (match-string 0)))
          (setq start-pos (match-beginning 0))
          (if (memq starter translation-chars)
                (translate-region start-pos (match-end 0) translation-table)
                (goto-char start-pos))
              ;; from
              (if (or (= start-pos (point-min))
                      (and (= 0 (get-char-code-property starter 
                           (/= 0 (get-char-code-property (char-after (1- 
                  start-pos (1- start-pos))
              ;; to
              (if (looking-at ucs-normalize-combining-chars-regexp)
                  (match-end 0) (1+ start-pos))
              'ucs-normalize-nfd-table t))))))))

(defun ucs-normalize-decomposition-region (from to translation-table)
      (narrow-to-region from to)
      (goto-char (point-min))
      (let (start-pos starter)
        (while (re-search-forward ucs-normalize-combining-chars-regexp nil t)
          (setq starter (string-to-char (match-string 0)))
          (setq start-pos (match-beginning 0))
            (if (= start-pos (point-min)) start-pos (1- start-pos))
            (match-end 0)
            translation-table nil))))
      (translate-region (point-min) (point-max) translation-table))))


(defun ucs-normalize-NFC-region (from to)
  "Normalize the current region by the Unicode NFC."
  (interactive "r")
  (ucs-normalize-composition-region from to 
(defun ucs-normalize-NFC-string (str)
  "Normalize the string STR by the Unicode NFC."
    (insert str)
    (ucs-normalize-NFC-region (point-min) (point-max))
(defun ucs-normalize-NFD-region (from to)
  "Normalize the current region by the Unicode NFD."
  (interactive "r")
  (ucs-normalize-decomposition-region from to 'ucs-normalize-nfd-table))
(defun ucs-normalize-NFD-string (str)
  "Normalize the string STR by the Unicode NFD."
    (insert str)
    (ucs-normalize-NFD-region (point-min) (point-max))

(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-composition-region from to
(defun ucs-normalize-HFS-NFC-string (str)
  "Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus."
    (insert str)
    (ucs-normalize-HFS-NFC-region (point-min) (point-max))
(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-decomposition-region from to 'ucs-normalize-hfs-nfd-table))
(defun ucs-normalize-HFS-NFD-string (str)
  "Normalize the string STR by the Unicode NFD and Mac OS's HFS Plus."
    (insert str)
    (ucs-normalize-HFS-NFD-region (point-min) (point-max))

(defun ucs-normalize-NFKC-region (from to)
  "Normalize the current region by the Unicode NFKC."
  (interactive "r")
  (ucs-normalize-composition-region from to
                                ucs-normalize-nfc-translation-chars t))
(defun ucs-normalize-NFKC-string (str)
  "Normalize the string STR by the Unicode NFKC."
    (insert str)
    (ucs-normalize-NFKC-region (point-min) (point-max))
(defun ucs-normalize-NFKD-region (from to)
  "Normalize the current region by the Unicode NFKD."
  (interactive "r")
  (ucs-normalize-decomposition-region from to 'ucs-normalize-nfkd-table))
(defun ucs-normalize-NFKD-string (str)
  "Normalize the string STR by the Unicode NFKD."
    (insert str)
    (ucs-normalize-NFKD-region (point-min) (point-max))

;; Post-read-conversion function for `utf-8-hfs'.
(defun ucs-normalize-hfs-nfd-post-read-conversion (len)
      (narrow-to-region (point) (+ (point) len))
      (let ((buffer-modified-p (buffer-modified-p)))
        (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 characters in HFS normalization exclusion area are not normalized.
On encoding, don't perform normalization."
  :coding-type 'utf-8
  :mnemonic ?U
  :charset-list '(unicode)
  ;; NFD decoder
  ;; :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

;;; normalize.el ends here

reply via email to

[Prev in Thread] Current Thread [Next in Thread]