HCoop
/
bpt
/
emacs.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
update unidata-gen.el
[bpt/emacs.git]
/
admin
/
unidata
/
unidata-gen.el
diff --git
a/admin/unidata/unidata-gen.el
b/admin/unidata/unidata-gen.el
index
1002bb0
..
8b24b11
100644
(file)
--- a/
admin/unidata/unidata-gen.el
+++ b/
admin/unidata/unidata-gen.el
@@
-1,4
+1,7
@@
;; unidata-gen.el -- Create files containing character property data.
;; unidata-gen.el -- Create files containing character property data.
+
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
+
;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011
;; National Institute of Advanced Industrial Science and Technology (AIST)
;; Registration Number H13PRO009
@@
-23,13
+26,12
@@
;; SPECIAL NOTICE
;;
;; This file must be byte-compilable/loadable by `temacs' and also
;; SPECIAL NOTICE
;;
;; This file must be byte-compilable/loadable by `temacs' and also
-;; the entry function `unidata-gen-files' must be runnable by
-;; `temacs'.
+;; the entry function `unidata-gen-files' must be runnable by `temacs'.
;; FILES TO BE GENERATED
;;
;; The entry function `unidata-gen-files' generates these files in
;; FILES TO BE GENERATED
;;
;; The entry function `unidata-gen-files' generates these files in
-;;
the current directory
.
+;;
in directory specified by its dest-dir argument
.
;;
;; charprop.el
;; It contains a series of forms of this format:
;;
;; charprop.el
;; It contains a series of forms of this format:
@@
-88,9
+90,9
@@
(defvar unidata-list nil)
(defvar unidata-list nil)
-;; Name of the directory containing files of Unicode Character
-;; Database.
+;; Name of the directory containing files of Unicode Character Database.
+;; Dynamically bound in unidata-gen-files.
(defvar unidata-dir nil)
(defun unidata-setup-list (unidata-text-file)
(defvar unidata-dir nil)
(defun unidata-setup-list (unidata-text-file)
@@
-158,7
+160,7
@@
;; DEFAULT: the default value of the property. It may have the form
;; (VAL0 (FROM1 TO1 VAL1) ...) which indicates that the default
;; value is VAL0 except for characters in the ranges specified by
;; DEFAULT: the default value of the property. It may have the form
;; (VAL0 (FROM1 TO1 VAL1) ...) which indicates that the default
;; value is VAL0 except for characters in the ranges specified by
-;; FROMn and TOn (incusive). The default value of characters
+;; FROMn and TOn (inc
l
usive). The default value of characters
;; between FROMn and TOn is VALn.
;; VAL-LIST: list of specially ordered property values
;; between FROMn and TOn is VALn.
;; VAL-LIST: list of specially ordered property values
@@
-166,9
+168,10
@@
'((name
1 unidata-gen-table-name "uni-name.el"
"Unicode character name.
'((name
1 unidata-gen-table-name "uni-name.el"
"Unicode character name.
-Property value is a string."
+Property value is a string or nil.
+The value nil stands for the default value \"null string\")."
nil
nil
-
""
)
+
nil
)
(general-category
2 unidata-gen-table-symbol "uni-category.el"
"Unicode general category.
(general-category
2 unidata-gen-table-symbol "uni-category.el"
"Unicode general category.
@@
-191,8
+194,8
@@
Property value is an integer."
4 unidata-gen-table-symbol "uni-bidi.el"
"Unicode bidi class.
Property value is one of the following symbols:
4 unidata-gen-table-symbol "uni-bidi.el"
"Unicode bidi class.
Property value is one of the following symbols:
- L, LRE, LRO,
R, AL, RLE, RLO, PDF, EN, ES, ET
,
- AN, CS, NSM, BN, B, S, WS, ON"
+ 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
unidata-describe-bidi-class
;; The assignment of default values to blocks of code points
;; follows the file DerivedBidiClass.txt from the Unicode
@@
-202,7
+205,8
@@
Property value is one of the following symbols:
(#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.
(#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 ES ET CS NSM S WS ON))
+ (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.
(decomposition
5 unidata-gen-table-decomposition "uni-decomposition.el"
"Unicode decomposition mapping.
@@
-235,7
+239,8
@@
Property value is a symbol `Y' or `N'. See also the property `mirroring'."
(old-name
10 unidata-gen-table-name "uni-old-name.el"
"Unicode old names as published in Unicode 1.0.
(old-name
10 unidata-gen-table-name "uni-old-name.el"
"Unicode old names as published in Unicode 1.0.
-Property value is a string.")
+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.
(iso-10646-comment
11 unidata-gen-table-name "uni-comment.el"
"Unicode ISO 10646 comment.
@@
-393,12
+398,17
@@
is the character itself.")))
;; If VAL is one of VALn, just return n.
;; Otherwise, VAL-LIST is modified to this:
;; ((nil . 0) (VAL1 . 1) (VAL2 . 2) ... (VAL . n+1))
;; If VAL is one of VALn, just return n.
;; Otherwise, VAL-LIST is modified to this:
;; ((nil . 0) (VAL1 . 1) (VAL2 . 2) ... (VAL . n+1))
+;;
+;; WARN is an optional warning to display when the value list is
+;; extended, for property values that need to be in sync with other
+;; parts of Emacs; currently only used for bidi-class.
-(defun unidata-encode-val (val-list val)
+(defun unidata-encode-val (val-list val
&optional warn
)
(let ((slot (assoc val val-list))
val-code)
(if slot
(cdr slot)
(let ((slot (assoc val val-list))
val-code)
(if slot
(cdr slot)
+ (if warn (message warn val))
(setq val-code (length val-list))
(nconc val-list (list (cons val val-code)))
val-code)))
(setq val-code (length val-list))
(nconc val-list (list (cons val val-code)))
val-code)))
@@
-409,6
+419,16
@@
is the character itself.")))
(let ((table (make-char-table 'char-code-property-table))
(prop-idx (unidata-prop-index prop))
(vec (make-vector 128 0))
(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;
+ ;; (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
+ ;; (4) possibly update the switch cases in
+ ;; 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
prev-range-data)
(setq val-list (cons nil (copy-sequence val-list)))
tail elt range val val-code idx slot
prev-range-data)
(setq val-list (cons nil (copy-sequence val-list)))
@@
-434,7
+454,9
@@
is the character itself.")))
(setq elt (car tail) tail (cdr tail))
(setq range (car elt)
val (funcall val-func (nth prop-idx elt)))
(setq elt (car tail) tail (cdr tail))
(setq range (car elt)
val (funcall val-func (nth prop-idx elt)))
- (setq val-code (if val (unidata-encode-val val-list val)))
+ (setq val-code (if val (unidata-encode-val val-list val
+ (and (eq prop 'bidi-class)
+ bidi-warning))))
(if (consp range)
(when val-code
(set-char-table-range table range val-code)
(if (consp range)
(when val-code
(set-char-table-range table range val-code)
@@
-482,7
+504,9
@@
is the character itself.")))
(setq new-val (funcall val-func (nth prop-idx elt)))
(if (not (eq val new-val))
(setq val new-val
(setq new-val (funcall val-func (nth prop-idx elt)))
(if (not (eq val new-val))
(setq val new-val
- val-code (if val (unidata-encode-val val-list val))))
+ val-code (if val (unidata-encode-val
+ val-list val (and (eq prop 'bidi-class)
+ bidi-warning)))))
(if val-code
(aset vec (- range start) val-code))
(setq tail (cdr tail)))
(if val-code
(aset vec (- range start) val-code))
(setq tail (cdr tail)))
@@
-656,7
+680,7
@@
is the character itself.")))
;; Return a name of CHAR. VAL is the current value of (aref TABLE
;; CHAR).
;; Return a name of CHAR. VAL is the current value of (aref TABLE
;; CHAR).
-(
defun unidata-get-name
(char val table)
+(
fset 'unidata-get-name '(lambda
(char val table)
(cond
((stringp val)
(if (> (aref val 0) 0)
(cond
((stringp val)
(if (> (aref val 0) 0)
@@
-712,7
+736,7
@@
is the character itself.")))
(aset table c name)
(if (= c char)
(setq val name))))
(aset table c name)
(if (= c char)
(setq val name))))
-
(or val "")
)))
+
val
)))
((and (integerp val) (> val 0))
(let* ((symbol-table (aref (char-table-extra-slot table 4) 1))
((and (integerp val) (> val 0))
(let* ((symbol-table (aref (char-table-extra-slot table 4) 1))
@@
-738,17
+762,15
@@
is the character itself.")))
((eq sym 'CJK\ COMPATIBILITY\ IDEOGRAPH)
(format "%s-%04X" sym char))
((eq sym 'VARIATION\ SELECTOR)
((eq sym 'CJK\ COMPATIBILITY\ IDEOGRAPH)
(format "%s-%04X" sym char))
((eq sym 'VARIATION\ SELECTOR)
- (format "%s-%d" sym (+ (- char #xe0100) 17))))))
-
- (t "")))
+ (format "%s-%d" sym (+ (- char #xe0100) 17)))))))))
;; Store VAL as the name of CHAR in TABLE.
;; Store VAL as the name of CHAR in TABLE.
-(
defun unidata-put-name
(char val table)
+(
fset 'unidata-put-name '(lambda
(char val table)
(let ((current-val (aref table char)))
(if (and (stringp current-val) (= (aref current-val 0) 0))
(funcall (char-table-extra-slot table 1) char current-val table))
(let ((current-val (aref table char)))
(if (and (stringp current-val) (= (aref current-val 0) 0))
(funcall (char-table-extra-slot table 1) char current-val table))
- (aset table char val)))
+ (aset table char val)))
)
(defun unidata-get-decomposition (char val table)
(cond
(defun unidata-get-decomposition (char val table)
(cond
@@
-962,7
+984,14
@@
is the character itself.")))
(l nil)
(idx 0)
c)
(l nil)
(idx 0)
c)
- (if (= len 0)
+ (if (or (= len 0)
+ ;; Unicode Standard, paragraph 4.8: "For all other
+ ;; Unicode code points of all other types (Control,
+ ;; Private-Use, Surrogate, Noncharacter, and Reserved),
+ ;; the value of the Name property is the null string."
+ ;; We already handle elsewhere all the characters except
+ ;; Cc, Control characters, which are handled here.
+ (string= str "<control>"))
nil
(dotimes (i len)
(setq c (aref str i))
nil
(dotimes (i len)
(setq c (aref str i))
@@
-978,8
+1007,6
@@
is the character itself.")))
(defun unidata-gen-table-name (prop &rest ignore)
(let* ((table (unidata-gen-table-word-list prop 'unidata-split-name))
(word-tables (char-table-extra-slot table 4)))
(defun unidata-gen-table-name (prop &rest ignore)
(let* ((table (unidata-gen-table-word-list prop 'unidata-split-name))
(word-tables (char-table-extra-slot table 4)))
- (byte-compile 'unidata-get-name)
- (byte-compile '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))
(set-char-table-extra-slot table 1 (symbol-function 'unidata-get-name))
(set-char-table-extra-slot table 2 (symbol-function 'unidata-put-name))
@@
-1017,8
+1044,6
@@
is the character itself.")))
(defun unidata-gen-table-decomposition (prop &rest ignore)
(let* ((table (unidata-gen-table-word-list prop 'unidata-split-decomposition))
(word-tables (char-table-extra-slot table 4)))
(defun unidata-gen-table-decomposition (prop &rest ignore)
(let* ((table (unidata-gen-table-word-list prop 'unidata-split-decomposition))
(word-tables (char-table-extra-slot table 4)))
- (byte-compile 'unidata-get-decomposition)
- (byte-compile 'unidata-put-decomposition)
(set-char-table-extra-slot table 1
(symbol-function 'unidata-get-decomposition))
(set-char-table-extra-slot table 2
(set-char-table-extra-slot table 1
(symbol-function 'unidata-get-decomposition))
(set-char-table-extra-slot table 2
@@
-1028,7
+1053,8
@@
is the character itself.")))
\f
\f
-(defun unidata-describe-general-category (val)
+(fset
+ 'unidata-describe-general-category '(lambda (val)
(cdr (assq val
'((nil . "Uknown")
(Lu . "Letter, Uppercase")
(cdr (assq val
'((nil . "Uknown")
(Lu . "Letter, Uppercase")
@@
-1060,9
+1086,9
@@
is the character itself.")))
(Cf . "Other, Format")
(Cs . "Other, Surrogate")
(Co . "Other, Private Use")
(Cf . "Other, Format")
(Cs . "Other, Surrogate")
(Co . "Other, Private Use")
- (Cn . "Other, Not Assigned")))))
+ (Cn . "Other, Not Assigned")))))
)
-(
defun unidata-describe-canonical-combining-class
(val)
+(
fset 'unidata-describe-canonical-combining-class '(lambda
(val)
(cdr (assq val
'((0 . "Spacing, split, enclosing, reordrant, and Tibetan subjoined")
(1 . "Overlays and interior")
(cdr (assq val
'((0 . "Spacing, split, enclosing, reordrant, and Tibetan subjoined")
(1 . "Overlays and interior")
@@
-1089,9
+1115,9
@@
is the character itself.")))
(232 . "Above right")
(233 . "Double below")
(234 . "Double above")
(232 . "Above right")
(233 . "Double below")
(234 . "Double above")
- (240 . "Below (iota subscript)")))))
+ (240 . "Below (iota subscript)")))))
)
-(
defun unidata-describe-bidi-class
(val)
+(
fset 'unidata-describe-bidi-class '(lambda
(val)
(cdr (assq val
'((L . "Left-to-Right")
(LRE . "Left-to-Right Embedding")
(cdr (assq val
'((L . "Left-to-Right")
(LRE . "Left-to-Right Embedding")
@@
-1101,6
+1127,10
@@
is the character itself.")))
(RLE . "Right-to-Left Embedding")
(RLO . "Right-to-Left Override")
(PDF . "Pop Directional Format")
(RLE . "Right-to-Left Embedding")
(RLO . "Right-to-Left Override")
(PDF . "Pop Directional Format")
+ (LRI . "Left-to-Right Isolate")
+ (RLI . "Right-to-Left Isolate")
+ (FSI . "First Strong Isolate")
+ (PDI . "Pop Directional Isolate")
(EN . "European Number")
(ES . "European Number Separator")
(ET . "European Number Terminator")
(EN . "European Number")
(ES . "European Number Separator")
(ET . "European Number Terminator")
@@
-1111,7
+1141,7
@@
is the character itself.")))
(B . "Paragraph Separator")
(S . "Segment Separator")
(WS . "Whitespace")
(B . "Paragraph Separator")
(S . "Segment Separator")
(WS . "Whitespace")
- (ON . "Other Neutrals")))))
+ (ON . "Other Neutrals")))))
)
(defun unidata-describe-decomposition (val)
(mapconcat
(defun unidata-describe-decomposition (val)
(mapconcat
@@
-1176,18
+1206,21
@@
is the character itself.")))
;; The entry function. It generates files described in the header
;; comment of this file.
;; The entry function. It generates files described in the header
;; comment of this file.
-(defun unidata-gen-files (&optional data-dir unidata-text-file)
+;; Write files (charprop.el, uni-*.el) to dest-dir (default PWD),
+;; using as input files from data-dir, and
+;; unidata-text-file (default "unidata.txt" in PWD).
+(defun unidata-gen-files (&optional data-dir dest-dir unidata-text-file)
(or data-dir
(or data-dir
- (setq data-dir (
car
command-line-args-left)
-
command-line-args-left (cdr command-line-args-left
)
- unidata-text-file (
car
command-line-args-left)
-
command-line-args-left (cdr command-line-args-left
)))
+ (setq data-dir (
pop
command-line-args-left)
+
dest-dir (or (pop command-line-args-left) default-directory
)
+ unidata-text-file (
or (pop
command-line-args-left)
+
(expand-file-name "unidata.txt")
)))
(let ((coding-system-for-write 'utf-8-unix)
(let ((coding-system-for-write 'utf-8-unix)
- (charprop-file
"charprop.el"
)
+ (charprop-file
(expand-file-name "charprop.el" dest-dir)
)
(unidata-dir data-dir))
(dolist (elt unidata-prop-alist)
(let* ((prop (car elt))
(unidata-dir data-dir))
(dolist (elt unidata-prop-alist)
(let* ((prop (car elt))
- (file (
unidata-prop-file prop
)))
+ (file (
expand-file-name (unidata-prop-file prop) dest-dir
)))
(if (file-exists-p file)
(delete-file file))))
(unidata-setup-list unidata-text-file)
(if (file-exists-p file)
(delete-file file))))
(unidata-setup-list unidata-text-file)
@@
-1196,7
+1229,8
@@
is the character itself.")))
(dolist (elt unidata-prop-alist)
(let* ((prop (car elt))
(generator (unidata-prop-generator prop))
(dolist (elt unidata-prop-alist)
(let* ((prop (car elt))
(generator (unidata-prop-generator prop))
- (file (unidata-prop-file prop))
+ (file (expand-file-name (unidata-prop-file prop) dest-dir))
+ (basename (file-name-nondirectory file))
(docstring (unidata-prop-docstring prop))
(describer (unidata-prop-describer prop))
(default-value (unidata-prop-default prop))
(docstring (unidata-prop-docstring prop))
(describer (unidata-prop-describer prop))
(default-value (unidata-prop-default prop))
@@
-1204,10
+1238,11
@@
is the character itself.")))
table)
;; Filename in this comment line is extracted by sed in
;; Makefile.
table)
;; Filename in this comment line is extracted by sed in
;; Makefile.
- (insert (format ";; FILE: %s\n"
fil
e))
+ (insert (format ";; FILE: %s\n"
basenam
e))
(insert (format "(define-char-code-property '%S %S\n %S)\n"
(insert (format "(define-char-code-property '%S %S\n %S)\n"
- prop
fil
e docstring))
+ prop
basenam
e docstring))
(with-temp-buffer
(with-temp-buffer
+ (message "Using load-path %s" load-path)
(message "Generating %s..." file)
(when (file-exists-p file)
(insert-file-contents file)
(message "Generating %s..." file)
(when (file-exists-p file)
(insert-file-contents file)
@@
-1216,30
+1251,34
@@
is the character itself.")))
(setq table (funcall generator prop default-value val-list))
(when describer
(unless (subrp (symbol-function describer))
(setq table (funcall generator prop default-value val-list))
(when describer
(unless (subrp (symbol-function describer))
- (byte-compile describer)
(setq describer (symbol-function describer)))
(set-char-table-extra-slot table 3 describer))
(if (bobp)
(setq describer (symbol-function describer)))
(set-char-table-extra-slot table 3 describer))
(if (bobp)
- (insert ";; Copyright (C) 1991-20
09
Unicode, Inc.
+ (insert ";; Copyright (C) 1991-20
13
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"))
;; 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
%S
%S)\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"
prop table docstring))
(if (eobp)
(insert ";; Local Variables:\n"
";; coding: utf-8\n"
+ ";; version-control: never\n"
";; no-byte-compile: t\n"
";; no-byte-compile: t\n"
+ ";; no-update-autoloads: t\n"
";; End:\n\n"
";; End:\n\n"
- (format ";; %s ends here\n"
fil
e)))
+ (format ";; %s ends here\n"
basenam
e)))
(write-file file)
(message "Generating %s...done" file))))
(message "Writing %s..." charprop-file)
(insert ";; Local Variables:\n"
";; coding: utf-8\n"
(write-file file)
(message "Generating %s...done" file))))
(message "Writing %s..." charprop-file)
(insert ";; Local Variables:\n"
";; coding: utf-8\n"
+ ";; version-control: never\n"
";; no-byte-compile: t\n"
";; no-byte-compile: t\n"
+ ";; no-update-autoloads: t\n"
";; End:\n\n"
";; End:\n\n"
- (format ";; %s ends here\n" charprop-file)))))
+ (format ";; %s ends here\n"
+ (file-name-nondirectory charprop-file))))))
\f
\f