(defparameter add-comments nil)
(defstruct unicode-char
- (code nil :type integer)
+ (index nil :type integer)
(name nil :type string)
word-indices
word-indices-index
)
+(defstruct range
+ (index nil :type integer)
+ (start-code nil :type integer)
+ (end-code nil :type integer)
+)
+
(defstruct word-list
(hashed nil :type hash-table)
(sorted nil :type list)
length ; number of words
)
-(defun main (inputfile outputfile)
- (declare (type string inputfile outputfile))
+(defun main (inputfile outputfile aliasfile)
+ (declare (type string inputfile outputfile aliasfile))
#+UNICODE (setq *default-file-encoding* charset:utf-8)
- (let ((all-chars '()))
+ (let ((all-chars '())
+ (all-chars-hashed (make-hash-table :test #'equal))
+ (all-aliases '())
+ all-chars-and-aliases
+ (all-ranges '())
+ (name-index 0)
+ range)
;; Read all characters and names from the input file.
(with-open-file (istream inputfile :direction :input)
(loop
; specially as well.
(unless (or (<= #xF900 code #xFA2D) (<= #xFA30 code #xFA6A)
(<= #xFA70 code #xFAD9) (<= #x2F800 code #x2FA1D))
- ; Transform the code so that it fits in 16 bits. In
- ; Unicode 5.1 the following ranges are used.
- ; 0x00000..0x04DFF >>12= 0x00..0x04 -> 0x0..0x4
- ; 0x0A000..0x0AAFF >>12= 0x0A -> 0x5
- ; 0x0F900..0x0FFFF >>12= 0x0F -> 0x6
- ; 0x10000..0x10A58 >>12= 0x10 -> 0x7
- ; 0x12000..0x12473 >>12= 0x12 -> 0x8
- ; 0x1D000..0x1D7FF >>12= 0x1D -> 0x9
- ; 0x1F000..0x1F093 >>12= 0x1F -> 0xA
- ; 0x2F800..0x2FAFF >>12= 0x2F -> 0xB
- ; 0xE0000..0xE00FF >>12= 0xE0 -> 0xC
- (flet ((transform (x)
- (dpb
- (case (ash x -12)
- ((#x00 #x01 #x02 #x03 #x04) (ash x -12))
- (#x0A 5)
- (#x0F 6)
- (#x10 7)
- (#x12 8)
- (#x1D 9)
- (#x1F #xA)
- (#x2F #xB)
- (#xE0 #xC)
- (t (error "Update the transform function for 0x~5,'0X" x))
- )
- (byte 8 12)
- x
- )) )
- (push (make-unicode-char :code (transform code)
+ ;; Also ignore variationselectors; they are treated
+ ;; specially as well.
+ (unless (or (<= #xFE00 code #xFE0F) (<= #xE0100 code #xE01EF))
+ (push (make-unicode-char :index name-index
:name name-string)
- all-chars
- ) ) ) ) )
+ all-chars)
+ (setf (gethash code all-chars-hashed) (car all-chars))
+ ;; Update the contiguous range, or start a new range.
+ (if (and range (= (1+ (range-end-code range)) code))
+ (setf (range-end-code range) code)
+ (progn
+ (when range
+ (push range all-ranges))
+ (setq range (make-range :index name-index
+ :start-code code
+ :end-code code))))
+ (incf name-index)
+ (setq last-code code)
+ ) ) ) )
) ) ) )
(setq all-chars (nreverse all-chars))
+ (if range
+ (push range all-ranges))
+ (setq all-ranges (nreverse all-ranges))
+ (when aliasfile
+ ;; Read all characters and names from the alias file.
+ (with-open-file (istream aliasfile :direction :input)
+ (loop
+ (let ((line (read-line istream nil nil)))
+ (unless line (return))
+ (let* ((i1 (position #\; line))
+ (i2 (position #\; line :start (1+ i1)))
+ (code-string (subseq line 0 i1))
+ (code (parse-integer code-string :radix 16))
+ (name-string (subseq line (1+ i1) i2))
+ (uc (gethash code all-chars-hashed)))
+ (when uc
+ (push (make-unicode-char :index (unicode-char-index uc)
+ :name name-string)
+ all-aliases)
+ ) ) ) ) ) )
+ (setq all-aliases (nreverse all-aliases)
+ all-chars-and-aliases (append all-chars all-aliases))
;; Split into words.
(let ((words-by-length (make-array 0 :adjustable t)))
- (dolist (name (list* "HANGUL SYLLABLE" "CJK COMPATIBILITY" (mapcar #'unicode-char-name all-chars)))
+ (dolist (name (list* "HANGUL SYLLABLE" "CJK COMPATIBILITY" "VARIATION"
+ (mapcar #'unicode-char-name all-chars-and-aliases)))
(let ((i1 0))
(loop
(when (>= i1 (length name)) (return))
(setf (gethash word (word-list-hashed word-list)) ind-offset)
(incf ind-offset)
) ) ) )
- (dolist (word '("HANGUL" "SYLLABLE" "CJK" "COMPATIBILITY"))
+ (dolist (word '("HANGUL" "SYLLABLE" "CJK" "COMPATIBILITY" "VARIATION"))
(format ostream "#define UNICODE_CHARNAME_WORD_~A ~D~%" word
(gethash word (word-list-hashed (aref words-by-length (length word))))
) )
;; Compute the word-indices for every unicode-char.
- (dolist (uc all-chars)
+ (dolist (uc all-chars-and-aliases)
(let ((name (unicode-char-name uc))
(indices '()))
(let ((i1 0))
)
) )
;; Sort the list of unicode-chars by word-indices.
- (setq all-chars
- (sort all-chars
+ (setq all-chars-and-aliases
+ (sort all-chars-and-aliases
(lambda (vec1 vec2)
(let ((len1 (length vec1))
(len2 (length vec2)))
) )
;; Output the word-indices.
(format ostream "static const uint16_t unicode_names[~D] = {~%"
- (reduce #'+ (mapcar (lambda (uc) (length (unicode-char-word-indices uc))) all-chars))
+ (reduce #'+ (mapcar (lambda (uc) (length (unicode-char-word-indices uc))) all-chars-and-aliases))
)
(let ((i 0))
- (dolist (uc all-chars)
+ (dolist (uc all-chars-and-aliases)
(format ostream " ~{ ~D,~}"
(maplist (lambda (r) (+ (* 2 (car r)) (if (cdr r) 1 0)))
(coerce (unicode-char-word-indices uc) 'list)
(incf i (length (unicode-char-word-indices uc)))
) )
(format ostream "};~%")
- (format ostream "static const struct { uint16_t code; uint32_t name:24; }~%")
+ (format ostream "static const struct { uint16_t index; uint32_t name:24; }~%")
(format ostream "#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)~%__attribute__((__packed__))~%#endif~%")
- (format ostream "unicode_name_to_code[~D] = {~%"
- (length all-chars)
+ (format ostream "unicode_name_to_index[~D] = {~%"
+ (length all-chars-and-aliases)
)
- (dolist (uc all-chars)
+ (dolist (uc all-chars-and-aliases)
(format ostream " { 0x~4,'0X, ~D },"
- (unicode-char-code uc)
+ (unicode-char-index uc)
(unicode-char-word-indices-index uc)
)
(when add-comments
(format ostream "~%")
)
(format ostream "};~%")
- (format ostream "static const struct { uint16_t code; uint32_t name:24; }~%")
+ (format ostream "static const struct { uint16_t index; uint32_t name:24; }~%")
(format ostream "#if __GNUC__ > 2 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 7)~%__attribute__((__packed__))~%#endif~%")
- (format ostream "unicode_code_to_name[~D] = {~%"
+ (format ostream "unicode_index_to_name[~D] = {~%"
(length all-chars)
)
- (dolist (uc (sort (copy-list all-chars) #'< :key #'unicode-char-code))
+ (dolist (uc (sort (copy-list all-chars) #'< :key #'unicode-char-index))
(format ostream " { 0x~4,'0X, ~D },"
- (unicode-char-code uc)
+ (unicode-char-index uc)
(unicode-char-word-indices-index uc)
)
(when add-comments
)
(format ostream "};~%")
(format ostream "#define UNICODE_CHARNAME_MAX_LENGTH ~D~%"
- (reduce #'max (mapcar (lambda (uc) (length (unicode-char-name uc))) all-chars))
+ (reduce #'max (mapcar (lambda (uc) (length (unicode-char-name uc))) all-chars-and-aliases))
)
(format ostream "#define UNICODE_CHARNAME_MAX_WORDS ~D~%"
- (reduce #'max (mapcar (lambda (uc) (length (unicode-char-word-indices uc))) all-chars))
+ (reduce #'max (mapcar (lambda (uc) (length (unicode-char-word-indices uc))) all-chars-and-aliases))
)
+ (format ostream "static const struct { uint16_t index; uint32_t gap; uint16_t length; } unicode_ranges[~D] = {~%"
+ (length all-ranges))
+ (dolist (range all-ranges)
+ (format ostream " { ~D, ~D, ~D },~%"
+ (range-index range)
+ (- (range-start-code range) (range-index range))
+ (1+ (- (range-end-code range) (range-start-code range))))
+ )
+ (format ostream "};~%")
)
) ) )
-(main (first *args*) (second *args*))
+(main (first *args*) (second *args*) (third *args*))
projects / platform / upstream / gettext.git / blobdiff