mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-28 00:01:33 -08:00
Write each generated character property lisp file only once
* admin/unidata/unidata-gen.el (unidata-file-alist): Rename from unidata-prop-alist. All users changed. Use file name rather than property name as the key. (unidata-prop-prop): New function. (unidata-prop-index, unidata-prop-generator, unidata-prop-docstring) (unidata-prop-describer, unidata-prop-default, unidata-prop-val-list): Change to parse the argument rather than unidata-prop-alist. (unidata-gen-table-character, unidata-gen-table) (unidata-gen-table-symbol, unidata-gen-table-integer) (unidata-gen-table-numeric, unidata-gen-table-word-list) (unidata-gen-table-name, unidata-gen-table-decomposition) (unidata-gen-table-special-casing): Pass index as an argument. (unidata-check): Adapt to unidata-file-alist. Pass index to generator functions. (unidata-gen-files): Adapt to unidata-file-alist. Write each output file once only. Overwrite rather than delete.
This commit is contained in:
Glenn Morris
parent
46dafe4103
commit
d22ddf5944
1 changed files with 235 additions and 231 deletions
|
|
@ -149,14 +149,14 @@
|
|||
(setq unidata-list (cdr table))))
|
||||
|
||||
;; Alist of this form:
|
||||
;; (PROP INDEX GENERATOR FILENAME DOCSTRING DESCRIBER DEFAULT VAL-LIST)
|
||||
;; (FILENAME (PROP INDEX GENERATOR DOCSTRING DESCRIBER DEFAULT VAL-LIST) ...)
|
||||
;; FILENAME: filename to store the char-table(s)
|
||||
;; PROP: character property
|
||||
;; INDEX: index to each element of unidata-list for PROP.
|
||||
;; It may be a function that generates an alist of character codes
|
||||
;; vs. the corresponding property values. Currently, only character
|
||||
;; codepoints or symbol values are supported in this case.
|
||||
;; GENERATOR: function to generate a char-table
|
||||
;; FILENAME: filename to store the char-table
|
||||
;; DOCSTRING: docstring for the property
|
||||
;; DESCRIBER: function to call to get a description string of property value
|
||||
;; DEFAULT: the default value of the property. It may have the form
|
||||
|
|
@ -166,111 +166,132 @@
|
|||
;; between FROMn and TOn is VALn.
|
||||
;; VAL-LIST: list of specially ordered property values
|
||||
|
||||
(defconst unidata-prop-alist
|
||||
'((name
|
||||
1 unidata-gen-table-name "uni-name.el"
|
||||
"Unicode character name.
|
||||
(defconst unidata-file-alist
|
||||
'(("uni-name.el"
|
||||
(name
|
||||
1 unidata-gen-table-name
|
||||
"Unicode character name.
|
||||
Property value is a string or nil.
|
||||
The value nil stands for the default value \"null string\")."
|
||||
nil
|
||||
nil)
|
||||
(general-category
|
||||
2 unidata-gen-table-symbol "uni-category.el"
|
||||
"Unicode general category.
|
||||
nil
|
||||
nil))
|
||||
("uni-category.el"
|
||||
(general-category
|
||||
2 unidata-gen-table-symbol
|
||||
"Unicode general category.
|
||||
Property value is one of the following symbols:
|
||||
Lu, Ll, Lt, Lm, Lo, Mn, Mc, Me, Nd, Nl, No, Pc, Pd, Ps, Pe, Pi, Pf, Po,
|
||||
Sm, Sc, Sk, So, Zs, Zl, Zp, Cc, Cf, Cs, Co, Cn"
|
||||
unidata-describe-general-category
|
||||
Cn
|
||||
;; The order of elements must be in sync with unicode_category_t
|
||||
;; in src/character.h.
|
||||
(Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd Ps Pe Pi Pf Po
|
||||
Sm Sc Sk So Zs Zl Zp Cc Cf Cs Co Cn))
|
||||
(canonical-combining-class
|
||||
3 unidata-gen-table-integer "uni-combining.el"
|
||||
"Unicode canonical combining class.
|
||||
unidata-describe-general-category
|
||||
Cn
|
||||
;; The order of elements must be in sync with
|
||||
;; unicode_category_t in src/character.h.
|
||||
(Lu Ll Lt Lm Lo Mn Mc Me Nd Nl No Pc Pd Ps Pe Pi Pf Po
|
||||
Sm Sc Sk So Zs Zl Zp Cc Cf Cs Co Cn)))
|
||||
("uni-combining.el"
|
||||
(canonical-combining-class
|
||||
3 unidata-gen-table-integer
|
||||
"Unicode canonical combining class.
|
||||
Property value is an integer."
|
||||
unidata-describe-canonical-combining-class
|
||||
0)
|
||||
(bidi-class
|
||||
4 unidata-gen-table-symbol "uni-bidi.el"
|
||||
"Unicode bidi class.
|
||||
unidata-describe-canonical-combining-class
|
||||
0))
|
||||
("uni-bidi.el"
|
||||
(bidi-class
|
||||
4 unidata-gen-table-symbol
|
||||
"Unicode bidi class.
|
||||
Property value is one of the following symbols:
|
||||
L, LRE, LRO, LRI, R, AL, RLE, RLO, RLI, FSI, PDF, PDI,
|
||||
EN, ES, ET, AN, CS, NSM, BN, B, S, WS, ON"
|
||||
unidata-describe-bidi-class
|
||||
;; The assignment of default values to blocks of code points
|
||||
;; follows the file DerivedBidiClass.txt from the Unicode
|
||||
;; Character Database (UCD).
|
||||
(L (#x0600 #x06FF AL) (#xFB50 #xFDFF AL) (#xFE70 #xFEFF AL)
|
||||
(#x0590 #x05FF R) (#x07C0 #x08FF R)
|
||||
(#xFB1D #xFB4F R) (#x10800 #x10FFF R) (#x1E800 #x1EFFF R))
|
||||
;; The order of elements must be in sync with bidi_type_t in
|
||||
;; src/dispextern.h.
|
||||
(L R EN AN BN B AL LRE LRO RLE RLO PDF LRI RLI FSI PDI
|
||||
ES ET CS NSM S WS ON))
|
||||
(decomposition
|
||||
5 unidata-gen-table-decomposition "uni-decomposition.el"
|
||||
"Unicode decomposition mapping.
|
||||
unidata-describe-bidi-class
|
||||
;; The assignment of default values to blocks of code points
|
||||
;; follows the file DerivedBidiClass.txt from the Unicode
|
||||
;; Character Database (UCD).
|
||||
(L (#x0600 #x06FF AL) (#xFB50 #xFDFF AL) (#xFE70 #xFEFF AL)
|
||||
(#x0590 #x05FF R) (#x07C0 #x08FF R)
|
||||
(#xFB1D #xFB4F R) (#x10800 #x10FFF R) (#x1E800 #x1EFFF R))
|
||||
;; The order of elements must be in sync with bidi_type_t in
|
||||
;; src/dispextern.h.
|
||||
(L R EN AN BN B AL LRE LRO RLE RLO PDF LRI RLI FSI PDI
|
||||
ES ET CS NSM S WS ON)))
|
||||
("uni-decomposition.el"
|
||||
(decomposition
|
||||
5 unidata-gen-table-decomposition
|
||||
"Unicode decomposition mapping.
|
||||
Property value is a list of characters. The first element may be
|
||||
one of these symbols representing compatibility formatting tag:
|
||||
font, noBreak, initial, medial, final, isolated, circle, super,
|
||||
sub, vertical, wide, narrow, small, square, fraction, compat"
|
||||
unidata-describe-decomposition)
|
||||
(decimal-digit-value
|
||||
6 unidata-gen-table-integer "uni-decimal.el"
|
||||
"Unicode numeric value (decimal digit).
|
||||
unidata-describe-decomposition))
|
||||
("uni-decimal.el"
|
||||
(decimal-digit-value
|
||||
6 unidata-gen-table-integer
|
||||
"Unicode numeric value (decimal digit).
|
||||
Property value is an integer 0..9, or nil.
|
||||
The value nil stands for NaN \"Numeric_Value\".")
|
||||
(digit-value
|
||||
7 unidata-gen-table-integer "uni-digit.el"
|
||||
"Unicode numeric value (digit).
|
||||
The value nil stands for NaN \"Numeric_Value\"."))
|
||||
("uni-digit.el"
|
||||
(digit-value
|
||||
7 unidata-gen-table-integer
|
||||
"Unicode numeric value (digit).
|
||||
Property value is an integer 0..9, or nil.
|
||||
The value nil stands for NaN \"Numeric_Value\".")
|
||||
(numeric-value
|
||||
8 unidata-gen-table-numeric "uni-numeric.el"
|
||||
"Unicode numeric value (numeric).
|
||||
The value nil stands for NaN \"Numeric_Value\"."))
|
||||
("uni-numeric.el"
|
||||
(numeric-value
|
||||
8 unidata-gen-table-numeric
|
||||
"Unicode numeric value (numeric).
|
||||
Property value is an integer, a floating point, or nil.
|
||||
The value nil stands for NaN \"Numeric_Value\".")
|
||||
(mirrored
|
||||
9 unidata-gen-table-symbol "uni-mirrored.el"
|
||||
"Unicode bidi mirrored flag.
|
||||
The value nil stands for NaN \"Numeric_Value\"."))
|
||||
("uni-mirrored.el"
|
||||
(mirrored
|
||||
9 unidata-gen-table-symbol
|
||||
"Unicode bidi mirrored flag.
|
||||
Property value is a symbol `Y' or `N'. See also the property `mirroring'."
|
||||
nil
|
||||
N)
|
||||
(old-name
|
||||
10 unidata-gen-table-name "uni-old-name.el"
|
||||
"Unicode old names as published in Unicode 1.0.
|
||||
nil
|
||||
N)
|
||||
(mirroring
|
||||
unidata-gen-mirroring-list unidata-gen-table-character
|
||||
"Unicode bidi-mirroring characters.
|
||||
Property value is a character that has the corresponding mirroring image or nil.
|
||||
The value nil means that the actual property value of a character
|
||||
is the character itself."))
|
||||
("uni-old-name.el"
|
||||
(old-name
|
||||
10 unidata-gen-table-name
|
||||
"Unicode old names as published in Unicode 1.0.
|
||||
Property value is a string or nil.
|
||||
The value nil stands for the default value \"null string\").")
|
||||
(iso-10646-comment
|
||||
11 unidata-gen-table-name "uni-comment.el"
|
||||
"Unicode ISO 10646 comment.
|
||||
Property value is a string.")
|
||||
(uppercase
|
||||
12 unidata-gen-table-character "uni-uppercase.el"
|
||||
"Unicode simple uppercase mapping.
|
||||
The value nil stands for the default value \"null string\")."))
|
||||
("uni-comment.el"
|
||||
(iso-10646-comment
|
||||
11 unidata-gen-table-name
|
||||
"Unicode ISO 10646 comment.
|
||||
Property value is a string."))
|
||||
("uni-uppercase.el"
|
||||
(uppercase
|
||||
12 unidata-gen-table-character
|
||||
"Unicode simple uppercase mapping.
|
||||
Property value is a character or nil.
|
||||
The value nil means that the actual property value of a character
|
||||
is the character itself."
|
||||
string)
|
||||
(lowercase
|
||||
13 unidata-gen-table-character "uni-lowercase.el"
|
||||
"Unicode simple lowercase mapping.
|
||||
string))
|
||||
("uni-lowercase.el"
|
||||
(lowercase
|
||||
13 unidata-gen-table-character
|
||||
"Unicode simple lowercase mapping.
|
||||
Property value is a character or nil.
|
||||
The value nil means that the actual property value of a character
|
||||
is the character itself."
|
||||
string)
|
||||
(titlecase
|
||||
14 unidata-gen-table-character "uni-titlecase.el"
|
||||
"Unicode simple titlecase mapping.
|
||||
string))
|
||||
("uni-titlecase.el"
|
||||
(titlecase
|
||||
14 unidata-gen-table-character
|
||||
"Unicode simple titlecase mapping.
|
||||
Property value is a character or nil.
|
||||
The value nil means that the actual property value of a character
|
||||
is the character itself."
|
||||
string)
|
||||
(special-uppercase
|
||||
2 unidata-gen-table-special-casing "uni-special-uppercase.el"
|
||||
"Unicode unconditional special casing mapping.
|
||||
string))
|
||||
("uni-special-uppercase.el"
|
||||
(special-uppercase
|
||||
2 unidata-gen-table-special-casing
|
||||
"Unicode unconditional special casing mapping.
|
||||
|
||||
Property value is (possibly empty) string or nil. The value nil denotes that
|
||||
`uppercase' property should be consulted instead. A string denotes what
|
||||
|
|
@ -279,10 +300,11 @@ sequence of characters given character maps into.
|
|||
This mapping includes language- and context-independent special casing rules
|
||||
defined by Unicode only. It also does not include association which would
|
||||
duplicate information from `uppercase' property."
|
||||
nil)
|
||||
(special-lowercase
|
||||
0 unidata-gen-table-special-casing "uni-special-lowercase.el"
|
||||
"Unicode unconditional special casing mapping.
|
||||
nil))
|
||||
("uni-special-lowercase.el"
|
||||
(special-lowercase
|
||||
0 unidata-gen-table-special-casing
|
||||
"Unicode unconditional special casing mapping.
|
||||
|
||||
Property value is (possibly empty) string or nil. The value nil denotes that
|
||||
`lowercase' property should be consulted instead. A string denotes what
|
||||
|
|
@ -291,10 +313,11 @@ sequence of characters given character maps into.
|
|||
This mapping includes language- and context-independent special casing rules
|
||||
defined by Unicode only. It also does not include association which would
|
||||
duplicate information from `lowercase' property."
|
||||
nil)
|
||||
(special-titlecase
|
||||
1 unidata-gen-table-special-casing "uni-special-titlecase.el"
|
||||
"Unicode unconditional special casing mapping.
|
||||
nil))
|
||||
("uni-special-titlecase.el"
|
||||
(special-titlecase
|
||||
1 unidata-gen-table-special-casing
|
||||
"Unicode unconditional special casing mapping.
|
||||
|
||||
Property value is (possibly empty) string or nil. The value nil denotes that
|
||||
`titlecase' property should be consulted instead. A string denotes what
|
||||
|
|
@ -303,38 +326,33 @@ sequence of characters given character maps into.
|
|||
This mapping includes language- and context-independent special casing rules
|
||||
defined by Unicode only. It also does not include association which would
|
||||
duplicate information from `titlecase' property."
|
||||
nil)
|
||||
(mirroring
|
||||
unidata-gen-mirroring-list unidata-gen-table-character "uni-mirrored.el"
|
||||
"Unicode bidi-mirroring characters.
|
||||
Property value is a character that has the corresponding mirroring image or nil.
|
||||
The value nil means that the actual property value of a character
|
||||
is the character itself.")
|
||||
(paired-bracket
|
||||
unidata-gen-brackets-list unidata-gen-table-character "uni-brackets.el"
|
||||
"Unicode bidi paired-bracket characters.
|
||||
nil))
|
||||
("uni-brackets.el"
|
||||
(paired-bracket
|
||||
unidata-gen-brackets-list unidata-gen-table-character
|
||||
"Unicode bidi paired-bracket characters.
|
||||
Property value is the paired bracket character, or nil.
|
||||
The value nil means that the character is neither an opening nor
|
||||
a closing paired bracket."
|
||||
string)
|
||||
(bracket-type
|
||||
unidata-gen-bracket-type-list unidata-gen-table-symbol "uni-brackets.el"
|
||||
"Unicode bidi paired-bracket type.
|
||||
string)
|
||||
(bracket-type
|
||||
unidata-gen-bracket-type-list unidata-gen-table-symbol
|
||||
"Unicode bidi paired-bracket type.
|
||||
Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
||||
unidata-describe-bidi-bracket-type
|
||||
n
|
||||
;; The order of elements must be in sync with bidi_bracket_type_t
|
||||
;; in src/dispextern.h.
|
||||
(n o c))))
|
||||
unidata-describe-bidi-bracket-type
|
||||
n
|
||||
;; The order of elements must be in sync with bidi_bracket_type_t
|
||||
;; in src/dispextern.h.
|
||||
(n o c)))))
|
||||
|
||||
;; Functions to access the above data.
|
||||
(defsubst unidata-prop-index (prop) (nth 1 (assq prop unidata-prop-alist)))
|
||||
(defsubst unidata-prop-generator (prop) (nth 2 (assq prop unidata-prop-alist)))
|
||||
(defsubst unidata-prop-file (prop) (nth 3 (assq prop unidata-prop-alist)))
|
||||
(defsubst unidata-prop-docstring (prop) (nth 4 (assq prop unidata-prop-alist)))
|
||||
(defsubst unidata-prop-describer (prop) (nth 5 (assq prop unidata-prop-alist)))
|
||||
(defsubst unidata-prop-default (prop) (nth 6 (assq prop unidata-prop-alist)))
|
||||
(defsubst unidata-prop-val-list (prop) (nth 7 (assq prop unidata-prop-alist)))
|
||||
(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))
|
||||
|
||||
|
||||
;; SIMPLE TABLE
|
||||
|
|
@ -362,9 +380,8 @@ 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 &rest ignore)
|
||||
(defun unidata-gen-table-character (prop prop-idx &rest ignore)
|
||||
(let ((table (make-char-table 'char-code-property-table))
|
||||
(prop-idx (unidata-prop-index prop))
|
||||
(vec (make-vector 128 0))
|
||||
(tail unidata-list)
|
||||
elt range val idx slot)
|
||||
|
|
@ -469,13 +486,12 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
|
||||
;; Generate a char-table for the character property PROP.
|
||||
|
||||
(defun unidata-gen-table (prop val-func default-value val-list)
|
||||
(defun unidata-gen-table (prop prop-idx val-func default-value val-list)
|
||||
(let ((table (make-char-table 'char-code-property-table))
|
||||
(prop-idx (unidata-prop-index prop))
|
||||
(vec (make-vector 128 0))
|
||||
;; When this warning is printed, there's a need to make the
|
||||
;; following changes:
|
||||
;; (1) update unidata-prop-alist with the new bidi-class values;
|
||||
;; (1) update unidata-file-alist with the new bidi-class values;
|
||||
;; (2) extend bidi_type_t enumeration on src/dispextern.h to
|
||||
;; include the new classes;
|
||||
;; (3) possibly update the assertion in bidi.c:bidi_check_type; and
|
||||
|
|
@ -596,8 +612,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(set-char-table-extra-slot table 4 (vconcat (mapcar 'car val-list)))
|
||||
table))
|
||||
|
||||
(defun unidata-gen-table-symbol (prop default-value val-list)
|
||||
(let ((table (unidata-gen-table prop
|
||||
(defun unidata-gen-table-symbol (prop index default-value val-list)
|
||||
(let ((table (unidata-gen-table prop index
|
||||
#'(lambda (x) (and (> (length x) 0)
|
||||
(intern x)))
|
||||
default-value val-list)))
|
||||
|
|
@ -605,8 +621,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(set-char-table-extra-slot table 2 1)
|
||||
table))
|
||||
|
||||
(defun unidata-gen-table-integer (prop default-value val-list)
|
||||
(let ((table (unidata-gen-table prop
|
||||
(defun unidata-gen-table-integer (prop index default-value val-list)
|
||||
(let ((table (unidata-gen-table prop index
|
||||
#'(lambda (x) (and (> (length x) 0)
|
||||
(string-to-number x)))
|
||||
default-value val-list)))
|
||||
|
|
@ -614,8 +630,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(set-char-table-extra-slot table 2 1)
|
||||
table))
|
||||
|
||||
(defun unidata-gen-table-numeric (prop default-value val-list)
|
||||
(let ((table (unidata-gen-table prop
|
||||
(defun unidata-gen-table-numeric (prop index default-value val-list)
|
||||
(let ((table (unidata-gen-table prop index
|
||||
#'(lambda (x)
|
||||
(if (string-match "/" x)
|
||||
(/ (float (string-to-number x))
|
||||
|
|
@ -921,9 +937,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
|
||||
;; Generate a char-table for character names.
|
||||
|
||||
(defun unidata-gen-table-word-list (prop val-func)
|
||||
(defun unidata-gen-table-word-list (prop prop-idx val-func)
|
||||
(let ((table (make-char-table 'char-code-property-table))
|
||||
(prop-idx (unidata-prop-index prop))
|
||||
(word-list (list nil))
|
||||
word-table
|
||||
block-list block-word-table block-end
|
||||
|
|
@ -1068,8 +1083,8 @@ 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 &rest ignore)
|
||||
(let* ((table (unidata-gen-table-word-list prop 'unidata-split-name))
|
||||
(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))
|
||||
|
|
@ -1106,8 +1121,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(nreverse l)))))
|
||||
|
||||
|
||||
(defun unidata-gen-table-decomposition (prop &rest ignore)
|
||||
(let* ((table (unidata-gen-table-word-list prop 'unidata-split-decomposition))
|
||||
(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
|
||||
'unidata-put-decomposition)
|
||||
|
|
@ -1149,9 +1164,8 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(forward-line)))
|
||||
result))
|
||||
|
||||
(defun unidata-gen-table-special-casing (prop &rest ignore)
|
||||
(let ((table (make-char-table 'char-code-property-table))
|
||||
(prop-idx (unidata-prop-index prop)))
|
||||
(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)
|
||||
(let ((ch (car entry)) (v (nth prop-idx (cdr entry))))
|
||||
|
|
@ -1322,56 +1336,57 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
;; (unidata-check))
|
||||
|
||||
(defun unidata-check ()
|
||||
(dolist (elt unidata-prop-alist)
|
||||
(let* ((prop (car elt))
|
||||
(index (unidata-prop-index prop))
|
||||
(generator (unidata-prop-generator prop))
|
||||
(default-value (unidata-prop-default prop))
|
||||
(val-list (unidata-prop-val-list prop))
|
||||
(table (progn
|
||||
(message "Generating %S table..." prop)
|
||||
(funcall generator prop default-value val-list)))
|
||||
(decoder (char-table-extra-slot table 1))
|
||||
(alist (and (functionp index)
|
||||
(funcall index)))
|
||||
(check #x400))
|
||||
(dolist (e unidata-list)
|
||||
(let* ((char (car e))
|
||||
(val1
|
||||
(if alist (nth 1 (assoc char alist))
|
||||
(nth index e)))
|
||||
val2)
|
||||
(if (and (stringp val1) (= (length val1) 0))
|
||||
(setq val1 nil))
|
||||
(unless (or (consp char)
|
||||
(integerp decoder))
|
||||
(setq val2
|
||||
(cond ((functionp decoder)
|
||||
(funcall decoder char (aref table char) table))
|
||||
(t ; must be nil
|
||||
(aref table char))))
|
||||
(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))))
|
||||
(when (>= char check)
|
||||
(message "%S %04X" prop check)
|
||||
(setq check (+ check #x400)))
|
||||
(or (equal val1 val2)
|
||||
;; <control> characters get a 'name' property of nil
|
||||
(and (eq prop 'name) (string= val1 "<control>") (null val2))
|
||||
(insert (format "> %04X %S\n< %04X %S\n"
|
||||
char val1 char val2)))
|
||||
(sit-for 0)))))))
|
||||
(dolist (elt unidata-file-alist)
|
||||
(dolist (proplist (cdr elt))
|
||||
(let* ((prop (unidata-prop-prop proplist))
|
||||
(index (unidata-prop-index proplist))
|
||||
(generator (unidata-prop-generator proplist))
|
||||
(default-value (unidata-prop-default proplist))
|
||||
(val-list (unidata-prop-val-list proplist))
|
||||
(table (progn
|
||||
(message "Generating %S table..." prop)
|
||||
(funcall generator prop index default-value val-list)))
|
||||
(decoder (char-table-extra-slot table 1))
|
||||
(alist (and (functionp index)
|
||||
(funcall index)))
|
||||
(check #x400))
|
||||
(dolist (e unidata-list)
|
||||
(let* ((char (car e))
|
||||
(val1
|
||||
(if alist (nth 1 (assoc char alist))
|
||||
(nth index e)))
|
||||
val2)
|
||||
(if (and (stringp val1) (= (length val1) 0))
|
||||
(setq val1 nil))
|
||||
(unless (or (consp char)
|
||||
(integerp decoder))
|
||||
(setq val2
|
||||
(cond ((functionp decoder)
|
||||
(funcall decoder char (aref table char) table))
|
||||
(t ; must be nil
|
||||
(aref table char))))
|
||||
(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))))
|
||||
(when (>= char check)
|
||||
(message "%S %04X" prop check)
|
||||
(setq check (+ check #x400)))
|
||||
(or (equal val1 val2)
|
||||
;; <control> characters get a 'name' property of nil
|
||||
(and (eq prop 'name) (string= val1 "<control>") (null val2))
|
||||
(insert (format "> %04X %S\n< %04X %S\n"
|
||||
char val1 char val2)))
|
||||
(sit-for 0))))))))
|
||||
|
||||
;; The entry function. It generates files described in the header
|
||||
;; comment of this file.
|
||||
|
|
@ -1389,61 +1404,50 @@ Property value is a symbol `o' (Open), `c' (Close), or `n' (None)."
|
|||
(coding-system-for-read 'utf-8)
|
||||
(charprop-file (expand-file-name "charprop.el" dest-dir))
|
||||
(unidata-dir data-dir))
|
||||
(dolist (elt unidata-prop-alist)
|
||||
(let* ((prop (car elt))
|
||||
(file (expand-file-name (unidata-prop-file prop) dest-dir)))
|
||||
(if (file-exists-p file)
|
||||
(delete-file file))))
|
||||
(unidata-setup-list unidata-text-file)
|
||||
(with-temp-file charprop-file
|
||||
(insert ";; Automatically generated by unidata-gen.el.\n")
|
||||
(dolist (elt unidata-prop-alist)
|
||||
(let* ((prop (car elt))
|
||||
(generator (unidata-prop-generator prop))
|
||||
(file (expand-file-name (unidata-prop-file prop) dest-dir))
|
||||
(dolist (elt unidata-file-alist)
|
||||
(let* ((file (expand-file-name (car elt) dest-dir))
|
||||
(basename (file-name-nondirectory file))
|
||||
(docstring (unidata-prop-docstring prop))
|
||||
(describer (unidata-prop-describer prop))
|
||||
(default-value (unidata-prop-default prop))
|
||||
(val-list (unidata-prop-val-list prop))
|
||||
;; Avoid creating backup files for those uni-*.el files
|
||||
;; that hold more than one table.
|
||||
(backup-inhibited t)
|
||||
table)
|
||||
;; Filename in this comment line is extracted by sed in
|
||||
;; Makefile.
|
||||
(cbuff (current-buffer)))
|
||||
(or noninteractive (message "Generating %s..." file))
|
||||
;; Filename in this comment line is extracted by sed in Makefile.
|
||||
(insert (format ";; FILE: %s\n" basename))
|
||||
(insert (format "(define-char-code-property '%S %S\n %S)\n"
|
||||
prop basename docstring))
|
||||
(with-temp-buffer
|
||||
(or noninteractive (message "Generating %s..." file))
|
||||
(when (file-exists-p file)
|
||||
(insert-file-contents file)
|
||||
(goto-char (point-max))
|
||||
(search-backward ";; Local Variables:"))
|
||||
(setq table (funcall generator prop default-value val-list))
|
||||
(when describer
|
||||
(unless (subrp (symbol-function describer))
|
||||
(unidata--ensure-compiled describer)
|
||||
(setq describer (symbol-function describer)))
|
||||
(set-char-table-extra-slot table 3 describer))
|
||||
(if (bobp)
|
||||
(insert ";; Copyright (C) 1991-2014 Unicode, Inc.
|
||||
(insert ";; Copyright (C) 1991-2014 Unicode, Inc.
|
||||
;; This file was generated from the Unicode data files at
|
||||
;; http://www.unicode.org/Public/UNIDATA/.
|
||||
;; See lisp/international/README for the copyright and permission notice.\n"))
|
||||
(insert (format "(define-char-code-property '%S\n %S\n %S)\n"
|
||||
prop table docstring))
|
||||
(if (eobp)
|
||||
(insert ";; Local Variables:\n"
|
||||
";; coding: utf-8\n"
|
||||
";; version-control: never\n"
|
||||
";; no-byte-compile: t\n"
|
||||
";; no-update-autoloads: t\n"
|
||||
";; End:\n\n"
|
||||
(format ";; %s ends here\n" basename)))
|
||||
(write-file file)
|
||||
(or noninteractive (message "Generating %s...done" file)))))
|
||||
;; See lisp/international/README for the copyright and permission notice.\n")
|
||||
(dolist (proplist (cdr elt))
|
||||
(let ((prop (unidata-prop-prop proplist))
|
||||
(index (unidata-prop-index proplist))
|
||||
(generator (unidata-prop-generator proplist))
|
||||
(docstring (unidata-prop-docstring proplist))
|
||||
(describer (unidata-prop-describer proplist))
|
||||
(default-value (unidata-prop-default proplist))
|
||||
(val-list (unidata-prop-val-list proplist))
|
||||
table)
|
||||
(with-current-buffer cbuff
|
||||
(insert (format "(define-char-code-property '%S %S\n %S)\n"
|
||||
prop basename docstring)))
|
||||
(setq table (funcall generator prop index default-value val-list))
|
||||
(when describer
|
||||
(unless (subrp (symbol-function describer))
|
||||
(unidata--ensure-compiled describer)
|
||||
(setq describer (symbol-function describer)))
|
||||
(set-char-table-extra-slot table 3 describer))
|
||||
(insert (format "(define-char-code-property '%S\n %S\n %S)\n"
|
||||
prop table docstring))))
|
||||
(insert ";; Local Variables:\n"
|
||||
";; coding: utf-8\n"
|
||||
";; version-control: never\n"
|
||||
";; no-byte-compile: t\n"
|
||||
";; no-update-autoloads: t\n"
|
||||
";; End:\n\n"
|
||||
(format ";; %s ends here\n" basename))
|
||||
(write-file file nil))
|
||||
(or noninteractive (message "Generating %s...done" file))))
|
||||
(message "Writing %s..." charprop-file)
|
||||
(insert ";; Local Variables:\n"
|
||||
";; coding: utf-8\n"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue