diff options
Diffstat (limited to 'admin/unidata/unidata-gen.el')
| -rw-r--r-- | admin/unidata/unidata-gen.el | 159 |
1 files changed, 77 insertions, 82 deletions
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index 71959d633c5..73453cb9e47 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -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))) |