diff options
Diffstat (limited to 'admin/unidata/unidata-gen.el')
| -rw-r--r-- | admin/unidata/unidata-gen.el | 466 |
1 files changed, 235 insertions, 231 deletions
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index 9ebcbe0705a..42489b13b61 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -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" |