Commit 3f8c191e authored by rtoy's avatar rtoy
Browse files

tools/build-unidata.lisp: 

o Read composition exclusions from the composition exclusions files
  and save it in unidata.bin.

code/unidata.lisp:
o Read composition exclusions from unidata.bin
o Use the exclusions from unidata.bin  instead of using the
  hand-initialized list.

i18n/unidata.bin:
o Updated with composition exclusions list.
parent 6301251e

code/unidata.lisp

+19 −21
Original line number Diff line number Diff line
@@ -4,7 +4,7 @@ 
;;; This code was written by Paul Foley and has been placed in the public

;;; domain.

;;; 

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unidata.lisp,v 1.1.2.24 2009/05/28 15:04:29 rtoy Exp $")

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unidata.lisp,v 1.1.2.25 2009/05/29 16:12:40 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -30,6 +30,7 @@ 
  qc-nfkd

  qc-nfc

  qc-nfkc

  comp-exclusions

  )



(defvar *unicode-data* (make-unidata))
@@ -556,6 +557,12 @@ 
    (setf (unidata-qc-nfkc *unicode-data*)

	(make-ntrie2 :split split :hvec hvec :mvec mvec :lvec lvec))))



(defloader load-composition-exclusions (stm 12)

  (let* ((len (read16 stm))

	 (ex (make-array len :element-type '(unsigned-byte 32))))

    (read-vector ex stm :endian-swap :network-order)

    (setf (unidata-comp-exclusions *unicode-data*) ex)))





;;; Accessor functions.
@@ -868,22 +875,12 @@ 
  (ecase (qref1 (unidata-qc-nfkd *unicode-data*) code)

    (0 :Y) (1 :N)))



;; @@ FIXME: This should be read from unidata.bin, but it's not there

;; yet.  This is CompositionExclusions.txt

(defvar *composition-exclusion*

  '(#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))

(defun unicode-composition-exclusions ()

  (unless (unidata-comp-exclusions *unicode-data*)

    (load-composition-exclusions))

  (unidata-comp-exclusions *unicode-data*))



;; Build the composition pair table.

;;

;; @@ FIXME:: The composition table should probably be in unidata.bin,

;; but it's not there yet.

(defun build-composition-table ()

  (let ((table (make-hash-table)))

    (dotimes (cp #x10ffff)
@@ -900,7 +897,8 @@ 
		  (c2 (char-code (aref decomp 1))))

	      (setf (gethash (logior (ash c1 16) c2) table) cp))))))

    ;; Remove any in the exclusion list

    (dolist (cp *composition-exclusion*)

    (loop for cp across (unicode-composition-exclusions)

       do

       (let ((decomp (unicode-decomp cp nil)))

	 (when (and decomp (= (length decomp) 2))

	   (let ((c1 (char-code (aref decomp 0)))

i18n/unidata.bin

+330 B (1.13 MiB)

File changed.

No diff preview for this file type.

View original file
View changed file

tools/build-unidata.lisp

+70 −43
Original line number Diff line number Diff line
@@ -4,7 +4,7 @@ 
;;; This code was written by Paul Foley and has been placed in the public

;;; domain.

;;; 

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/build-unidata.lisp,v 1.1.2.9 2009/05/25 20:08:29 rtoy Exp $")

(ext:file-comment "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/build-unidata.lisp,v 1.1.2.10 2009/05/29 16:12:40 rtoy Exp $")

;;;

;;; **********************************************************************

;;;
@@ -37,6 +37,7 @@ 
  qc-nfkd

  qc-nfc

  qc-nfkc

  comp-exclusions

  )



(defvar *unicode-data* (make-unidata))
@@ -403,7 +404,7 @@ 
	     (write16 (ldb (byte 16 0) n) stm)))

    (with-open-file (stm path :direction :io :if-exists :rename-and-delete

			 :element-type '(unsigned-byte 8))

      (let ((index (make-array 12 :fill-pointer 0)))

      (let ((index (make-array 13 :fill-pointer 0)))

	;; File header

	(write32 +unicode-magic-number+ stm)	; identification "magic"

	;; File format version
@@ -571,6 +572,11 @@ 
	  (write-vector (ntrie2-hvec data) stm :endian-swap :network-order)

	  (write-vector (ntrie2-mvec data) stm :endian-swap :network-order)

	  (write-vector (ntrie2-lvec data) stm :endian-swap :network-order))

	;; Write composition exclusion table

	(let ((data (unidata-comp-exclusions *unicode-data*)))

	  (vector-push (file-position stm) index)

	  (write16 (length data) stm)

	  (write-vector data stm :endian-swap :network-order))

	;; Patch up index

	(file-position stm 8)

	(dotimes (i (length index))
@@ -589,6 +595,7 @@ 
  aliases

  mcode

  norm-qc

  comp-exclusion

  ;; ...

  )
@@ -597,7 +604,8 @@ 
(defun foreach-ucd (name ucd-directory fn)

  (with-open-file (s (make-pathname :name name :type "txt"

				    :defaults ucd-directory))

    (if (string= name "Unihan")

    (cond

      ((string= name "Unihan")

       (loop for line = (read-line s nil) while line do

	     (when (char= (char line 0) #\U)

	       (let* ((tab1 (position #\Tab line))
@@ -605,7 +613,13 @@ 
		 (funcall fn

			  (parse-integer line :radix 16 :start 2 :end tab1)

			  (subseq line (1+ tab1) tab2)

		       (subseq line (1+ tab2))))))

			  (subseq line (1+ tab2)))))))

      ((string= name "CompositionExclusions")

       (loop for line = (read-line s nil) while line do

	     (let ((code (parse-integer line :radix 16 :junk-allowed t)))

	       (when code

		 (funcall fn code)))))

      (t

       (loop with save = 0

	     for line = (read-line s nil) as end = (position #\# line)

	     while line do
@@ -638,7 +652,7 @@ 
					    (subseq second 0 (- length 7)) ">")

			       (rest (rest split))))

		       (t

		       (apply fn lo hi (rest split))))))))))

			(apply fn lo hi (rest split)))))))))))



(defun parse-decomposition (string)

  (let ((type nil) (n 0))
@@ -727,6 +741,11 @@ 
		     (when ent

		       (setf (getf (ucdent-norm-qc ent) :nfkc)

			     (intern value "KEYWORD"))))))))

    (foreach-ucd "CompositionExclusions"

		 ucd-directory

      (lambda (min)		 

	(let ((entry (find min vec :key #'ucdent-code)))

	  (setf (ucdent-comp-exclusion entry) t))))

    (values vec (make-range :codes range))))
@@ -912,4 +931,12 @@ 
	      0 2 #x55)

      (setf (unidata-qc-nfkc *unicode-data*)

	    (make-ntrie2 :split #x55 :hvec hvec :mvec mvec :lvec lvec)))

    (format t "~&Building composition exclusion table~%")

    (let ((exclusions (make-array 1 :element-type '(unsigned-byte 32)

				  :adjustable t

				  :fill-pointer 0)))

      (loop for ent across ucd do

	   (when (ucdent-comp-exclusion ent)

	     (vector-push-extend (ucdent-code ent) exclusions)))

      (setf (unidata-comp-exclusions *unicode-data*) (copy-seq exclusions)))

    nil))