* admin/unidata/unidata-gen.el: Use lexical-binding
(unidata-prop): Use defstruct to define the 6 accessor functions. (unidata-gen-table-character, unidata-gen-table, unidata-gen-table-name) (unidata-check): Move common code out of `if`. (unidata-word-list-diff, unidata-split-decomposition): Move common code out of `if`; use `push`.
This commit is contained in:
Stefan Monnier
parent
576dfc8aa2
commit
a70feb0d73
1 changed files with 77 additions and 82 deletions
|
|
@ -1,4 +1,4 @@
|
|||
;; unidata-gen.el -- Create files containing character property data.
|
||||
;; unidata-gen.el -- Create files containing character property data -*- lexical-binding:t -*-
|
||||
|
||||
;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
|
||||
|
||||
|
|
@ -349,13 +349,10 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(n o c)))))
|
||||
|
||||
;; Functions to access the above data.
|
||||
(defsubst unidata-prop-prop (proplist) (nth 0 proplist))
|
||||
(defsubst unidata-prop-index (proplist) (nth 1 proplist))
|
||||
(defsubst unidata-prop-generator (proplist) (nth 2 proplist))
|
||||
(defsubst unidata-prop-docstring (proplist) (nth 3 proplist))
|
||||
(defsubst unidata-prop-describer (proplist) (nth 4 proplist))
|
||||
(defsubst unidata-prop-default (proplist) (nth 5 proplist))
|
||||
(defsubst unidata-prop-val-list (proplist) (nth 6 proplist))
|
||||
(cl-defstruct (unidata-prop
|
||||
(:type list)
|
||||
(:constructor nil))
|
||||
prop index generator docstring describer default val-list)
|
||||
|
||||
|
||||
;; SIMPLE TABLE
|
||||
|
|
@ -383,11 +380,11 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
;; 3rd: 0 (corresponding to uniprop_encode_character in chartab.c)
|
||||
;; 4th to 5th: nil
|
||||
|
||||
(defun unidata-gen-table-character (prop prop-idx &rest ignore)
|
||||
(defun unidata-gen-table-character (prop prop-idx &rest _ignore)
|
||||
(let ((table (make-char-table 'char-code-property-table))
|
||||
(vec (make-vector 128 0))
|
||||
(tail unidata-list)
|
||||
elt range val idx slot)
|
||||
elt range val)
|
||||
(if (functionp prop-idx)
|
||||
(setq tail (funcall prop-idx)
|
||||
prop-idx 1))
|
||||
|
|
@ -395,9 +392,9 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(setq elt (car tail) tail (cdr tail))
|
||||
(setq range (car elt)
|
||||
val (nth prop-idx elt))
|
||||
(if (= (length val) 0)
|
||||
(setq val nil)
|
||||
(setq val (string-to-number val 16)))
|
||||
(setq val (if (= (length val) 0)
|
||||
nil
|
||||
(string-to-number val 16)))
|
||||
(if (consp range)
|
||||
(if val
|
||||
(set-char-table-range table range val))
|
||||
|
|
@ -419,8 +416,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(setq first-index last-index)))
|
||||
(setq tail (cdr tail)))
|
||||
(when first-index
|
||||
(let ((str (string 1 first-index))
|
||||
c)
|
||||
(let ((str (string 1 first-index)))
|
||||
(while (<= first-index last-index)
|
||||
(setq str (format "%s%c" str (or (aref vec first-index) 0))
|
||||
first-index (1+ first-index)))
|
||||
|
|
@ -502,7 +498,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
;; bidi.c:bidi_get_type and bidi.c:bidi_get_category.
|
||||
(bidi-warning "\
|
||||
** Found new bidi-class `%s', please update bidi.c and dispextern.h")
|
||||
tail elt range val val-code idx slot
|
||||
tail elt range val val-code
|
||||
prev-range-data)
|
||||
(setq val-list (cons nil (copy-sequence val-list)))
|
||||
(setq tail val-list val-code 0)
|
||||
|
|
@ -510,9 +506,9 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(while tail
|
||||
(setcar tail (cons (car tail) val-code))
|
||||
(setq tail (cdr tail) val-code (1+ val-code)))
|
||||
(if (consp default-value)
|
||||
(setq default-value (copy-sequence default-value))
|
||||
(setq default-value (list default-value)))
|
||||
(setq default-value (if (consp default-value)
|
||||
(copy-sequence default-value)
|
||||
(list default-value)))
|
||||
(setcar default-value
|
||||
(unidata-encode-val val-list (car default-value)))
|
||||
(set-char-table-range table t (car default-value))
|
||||
|
|
@ -602,17 +598,17 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(if (= count 128)
|
||||
(if val
|
||||
(set-char-table-range table (cons start limit) val-code))
|
||||
(if (= val-code 0)
|
||||
(set-char-table-range table (cons start limit) str)
|
||||
(if (> count 2)
|
||||
(setq str (concat str (string val-code (+ count 128))))
|
||||
(if (= count 2)
|
||||
(setq str (concat str (string val-code val-code)))
|
||||
(setq str (concat str (string val-code)))))
|
||||
(set-char-table-range table (cons start limit) str))))))
|
||||
(set-char-table-range table (cons start limit)
|
||||
(if (= val-code 0)
|
||||
str
|
||||
(concat str (if (> count 2)
|
||||
(string val-code (+ count 128))
|
||||
(if (= count 2)
|
||||
(string val-code val-code)
|
||||
(string val-code))))))))))
|
||||
|
||||
(set-char-table-extra-slot table 0 prop)
|
||||
(set-char-table-extra-slot table 4 (vconcat (mapcar 'car val-list)))
|
||||
(set-char-table-extra-slot table 4 (vconcat (mapcar #'car val-list)))
|
||||
table))
|
||||
|
||||
(defun unidata-gen-table-symbol (prop index default-value val-list)
|
||||
|
|
@ -679,8 +675,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(let ((beg 0)
|
||||
(end 0)
|
||||
(len1 (length l1))
|
||||
(len2 (length l2))
|
||||
result)
|
||||
(len2 (length l2)))
|
||||
(when (< len1 16)
|
||||
(while (and l1 (eq (car l1) (car l2)))
|
||||
(setq beg (1+ beg)
|
||||
|
|
@ -688,13 +683,13 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(while (and (< end len1) (< end len2)
|
||||
(eq (nth (- len1 end 1) l1) (nth (- len2 end 1) l2)))
|
||||
(setq end (1+ end))))
|
||||
(if (= (+ beg end) 0)
|
||||
(setq result (list -1))
|
||||
(setq result (list (+ (* beg 16) (+ beg (- len1 end))))))
|
||||
(while (< end len2)
|
||||
(setcdr result (cons (nth (- len2 end 1) l2) (cdr result)))
|
||||
(setq end (1+ end)))
|
||||
result))
|
||||
(let ((result (list (if (= (+ beg end) 0)
|
||||
-1
|
||||
(+ (* beg 16) (+ beg (- len1 end)))))))
|
||||
(while (< end len2)
|
||||
(push (nth (- len2 end 1) l2) (cdr result))
|
||||
(setq end (1+ end)))
|
||||
result)))
|
||||
|
||||
;; Return a compressed form of the vector VEC. Each element of VEC is
|
||||
;; a list of symbols of which names can be concatenated to form a
|
||||
|
|
@ -703,7 +698,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
;; elements is usually small.
|
||||
|
||||
(defun unidata-word-list-compress (vec)
|
||||
(let (last-elt last-idx diff-head tail elt val)
|
||||
(let (last-elt last-idx diff-head elt val)
|
||||
(dotimes (i 128)
|
||||
(setq elt (aref vec i))
|
||||
(when elt
|
||||
|
|
@ -768,7 +763,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(vec (make-vector 128 nil))
|
||||
(idx 0)
|
||||
(case-fold-search nil)
|
||||
c word-list tail-list last-list word diff-head)
|
||||
c word-list tail-list last-list diff-head)
|
||||
(while (< i len)
|
||||
(setq c (aref val i))
|
||||
(if (< c 3)
|
||||
|
|
@ -784,7 +779,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(setq diff-head
|
||||
(prog1 (aref val i) (setq i (1+ i)))))
|
||||
(setq tail-list (nthcdr (% diff-head 16) last-list))
|
||||
(dotimes (i (/ diff-head 16))
|
||||
(dotimes (_ (/ diff-head 16))
|
||||
(setq word-list (nconc word-list (list (car l)))
|
||||
l (cdr l))))))
|
||||
(setq word-list
|
||||
|
|
@ -808,7 +803,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(setcdr tail (cons elt (cdr tail)))
|
||||
(setcar tail " ")))
|
||||
(setq tail (cddr tail)))
|
||||
(setq name (apply 'concat name))))
|
||||
(setq name (apply #'concat name))))
|
||||
(aset table c name)
|
||||
(if (= c char)
|
||||
(setq val name))))
|
||||
|
|
@ -872,7 +867,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(vec (make-vector 128 nil))
|
||||
(idx 0)
|
||||
(case-fold-search nil)
|
||||
c word-list tail-list last-list word diff-head)
|
||||
c word-list tail-list last-list diff-head)
|
||||
(while (< i len)
|
||||
(setq c (aref val i))
|
||||
(if (< c 3)
|
||||
|
|
@ -888,7 +883,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(setq diff-head
|
||||
(prog1 (aref val i) (setq i (1+ i)))))
|
||||
(setq tail-list (nthcdr (% diff-head 16) last-list))
|
||||
(dotimes (i (/ diff-head 16))
|
||||
(dotimes (_ (/ diff-head 16))
|
||||
(setq word-list (nconc word-list (list (car l)))
|
||||
l (cdr l))))))
|
||||
(setq word-list
|
||||
|
|
@ -945,7 +940,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(word-list (list nil))
|
||||
word-table
|
||||
block-list block-word-table block-end
|
||||
tail elt range val idx slot)
|
||||
tail elt range val idx)
|
||||
(setq tail unidata-list)
|
||||
(setq block-end -1)
|
||||
(while tail
|
||||
|
|
@ -984,9 +979,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(push (list val range) block-list))))
|
||||
(let* ((start (ash (ash range -7) 7))
|
||||
(limit (+ start 127))
|
||||
(first tail)
|
||||
(vec (make-vector 128 nil))
|
||||
c name len)
|
||||
(vec (make-vector 128 nil)))
|
||||
(if (<= start block-end)
|
||||
;; START overlap with the previous block.
|
||||
(aset table range (nth prop-idx elt))
|
||||
|
|
@ -1037,10 +1030,10 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(cdr (assq elt word-list))))
|
||||
(setcar tail (string code))
|
||||
(setq tail (cdr tail)))
|
||||
(aset vec i (mapconcat 'identity (aref vec i) "")))))
|
||||
(aset vec i (mapconcat #'identity (aref vec i) "")))))
|
||||
(set-char-table-range
|
||||
table (cons idx (+ idx 127))
|
||||
(mapconcat 'identity vec "")))))
|
||||
(mapconcat #'identity vec "")))))
|
||||
|
||||
(setq block-word-table (make-vector (length block-list) nil))
|
||||
(setq idx 0)
|
||||
|
|
@ -1086,19 +1079,18 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(or (byte-code-function-p (symbol-function fun))
|
||||
(byte-compile fun))))
|
||||
|
||||
(defun unidata-gen-table-name (prop index &rest ignore)
|
||||
(defun unidata-gen-table-name (prop index &rest _ignore)
|
||||
(let* ((table (unidata-gen-table-word-list prop index 'unidata-split-name))
|
||||
(word-tables (char-table-extra-slot table 4)))
|
||||
(unidata--ensure-compiled 'unidata-get-name 'unidata-put-name)
|
||||
(set-char-table-extra-slot table 1 (symbol-function 'unidata-get-name))
|
||||
(set-char-table-extra-slot table 2 (symbol-function 'unidata-put-name))
|
||||
|
||||
(if (eq prop 'name)
|
||||
(set-char-table-extra-slot table 4
|
||||
(set-char-table-extra-slot table 4
|
||||
(if (eq prop 'name)
|
||||
(vector (car word-tables)
|
||||
(cdr word-tables)
|
||||
unidata-name-jamo-name-table))
|
||||
(set-char-table-extra-slot table 4
|
||||
unidata-name-jamo-name-table)
|
||||
(vector (car word-tables))))
|
||||
table))
|
||||
|
||||
|
|
@ -1107,24 +1099,25 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
str
|
||||
(let ((len (length str))
|
||||
(l nil)
|
||||
(idx 0)
|
||||
c)
|
||||
(idx 0))
|
||||
(if (= len 0)
|
||||
nil
|
||||
(dotimes (i len)
|
||||
(setq c (aref str i))
|
||||
(if (= c 32)
|
||||
(setq l (if (= (aref str idx) ?<)
|
||||
(cons (intern (substring str (1+ idx) (1- i))) l)
|
||||
(cons (string-to-number (substring str idx i) 16) l))
|
||||
idx (1+ i))))
|
||||
(if (= (aref str idx) ?<)
|
||||
(setq l (cons (intern (substring str (1+ idx) (1- len))) l))
|
||||
(setq l (cons (string-to-number (substring str idx len) 16) l)))
|
||||
(let ((c (aref str i)))
|
||||
(when (= c ?\s)
|
||||
(push (if (= (aref str idx) ?<)
|
||||
(intern (substring str (1+ idx) (1- i)))
|
||||
(string-to-number (substring str idx i) 16))
|
||||
l)
|
||||
(setq idx (1+ i)))))
|
||||
(push (if (= (aref str idx) ?<)
|
||||
(intern (substring str (1+ idx) (1- len)))
|
||||
(string-to-number (substring str idx len) 16))
|
||||
l)
|
||||
(nreverse l)))))
|
||||
|
||||
|
||||
(defun unidata-gen-table-decomposition (prop index &rest ignore)
|
||||
(defun unidata-gen-table-decomposition (prop index &rest _ignore)
|
||||
(let* ((table (unidata-gen-table-word-list prop index 'unidata-split-decomposition))
|
||||
(word-tables (char-table-extra-slot table 4)))
|
||||
(unidata--ensure-compiled 'unidata-get-decomposition
|
||||
|
|
@ -1167,7 +1160,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(forward-line)))
|
||||
result))
|
||||
|
||||
(defun unidata-gen-table-special-casing (prop prop-idx &rest ignore)
|
||||
(defun unidata-gen-table-special-casing (prop prop-idx &rest _ignore)
|
||||
(let ((table (make-char-table 'char-code-property-table)))
|
||||
(set-char-table-extra-slot table 0 prop)
|
||||
(mapc (lambda (entry)
|
||||
|
|
@ -1175,7 +1168,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
;; If character maps to a single character, the mapping is already
|
||||
;; covered by regular casing property. Don’t store those.
|
||||
(when (/= (length v) 1)
|
||||
(set-char-table-range table ch (apply 'string v)))))
|
||||
(set-char-table-range table ch (apply #'string v)))))
|
||||
(or unidata-gen-table-special-casing--cache
|
||||
(setq unidata-gen-table-special-casing--cache
|
||||
(unidata-gen-table-special-casing--do-load))))
|
||||
|
|
@ -1353,7 +1346,7 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
;; unidata-gen-table-special-casing--do-load and there is no other file
|
||||
;; to compare those values with. This is why we’re skipping the check
|
||||
;; for special casing properties.
|
||||
(unless (eq generator 'unidata-gen-table-special-casing)
|
||||
(unless (eq generator #'unidata-gen-table-special-casing)
|
||||
(setq table (progn
|
||||
(message "Generating %S table..." prop)
|
||||
(funcall generator prop index default-value val-list))
|
||||
|
|
@ -1369,19 +1362,21 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(and (stringp val1)
|
||||
(= (length val1) 0)
|
||||
(setq val1 nil))
|
||||
(if val1
|
||||
(cond ((eq generator 'unidata-gen-table-symbol)
|
||||
(setq val1 (intern val1)))
|
||||
((eq generator 'unidata-gen-table-integer)
|
||||
(setq val1 (string-to-number val1)))
|
||||
((eq generator 'unidata-gen-table-character)
|
||||
(setq val1 (string-to-number val1 16)))
|
||||
((eq generator 'unidata-gen-table-decomposition)
|
||||
(setq val1 (unidata-split-decomposition val1))))
|
||||
(cond ((eq prop 'decomposition)
|
||||
(setq val1 (list char)))
|
||||
((eq prop 'bracket-type)
|
||||
(setq val1 'n))))
|
||||
(setq val1
|
||||
(if val1
|
||||
(cond ((eq generator #'unidata-gen-table-symbol)
|
||||
(intern val1))
|
||||
((eq generator #'unidata-gen-table-integer)
|
||||
(string-to-number val1))
|
||||
((eq generator #'unidata-gen-table-character)
|
||||
(string-to-number val1 16))
|
||||
((eq generator #'unidata-gen-table-decomposition)
|
||||
(unidata-split-decomposition val1))
|
||||
(t val1))
|
||||
(cond ((eq prop 'decomposition)
|
||||
(list char))
|
||||
((eq prop 'bracket-type)
|
||||
'n))))
|
||||
(setq val2 (aref table char))
|
||||
(when decoder
|
||||
(setq val2 (funcall decoder char val2 table)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue