aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--admin/unidata/unidata-gen.el61
1 files changed, 59 insertions, 2 deletions
diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el
index 84fd8889ae0..786f77692f0 100644
--- a/admin/unidata/unidata-gen.el
+++ b/admin/unidata/unidata-gen.el
@@ -179,7 +179,7 @@ Property value is an integer.")
179 "Unicode numeric value (digit). 179 "Unicode numeric value (digit).
180Property value is an integer.") 180Property value is an integer.")
181 (numeric-value 181 (numeric-value
182 8 unidata-gen-table-symbol "uni-numeric.el" 182 8 unidata-gen-table-numeric "uni-numeric.el"
183 "Unicode numeric value (numeric). 183 "Unicode numeric value (numeric).
184Property value is a symbol.") 184Property value is a symbol.")
185 (mirrored 185 (mirrored
@@ -393,6 +393,34 @@ Property value is a character."
393 (setq first-char (1+ first-char)))) 393 (setq first-char (1+ first-char))))
394 this-val))))) 394 this-val)))))
395 395
396;; Return a numeric-type (integer or float) character property value
397;; of CHAR. VAL is the current value of (aref TABLE CHAR).
398
399(defun unidata-get-numeric (char val table)
400 (cond
401 ((numberp val)
402 val)
403 ((stringp val)
404 (let ((val-table (char-table-extra-slot table 4))
405 (first-char (lsh (lsh char -7) 7))
406 (str val)
407 (len (length val))
408 (idx 0)
409 this-val count)
410 (while (< idx len)
411 (setq val (aref str idx) idx (1+ idx)
412 count (if (< idx len) (aref str idx) 1))
413 (setq val (and (> val 0) (aref val-table (1- val)))
414 count (if (< count 128)
415 1
416 (prog1 (- count 128) (setq idx (1+ idx)))))
417 (dotimes (i count)
418 (aset table first-char val)
419 (if (= first-char char)
420 (setq this-val val))
421 (setq first-char (1+ first-char))))
422 this-val))))
423
396;; Store VAL (symbol) as a character property value of CHAR in TABLE. 424;; Store VAL (symbol) as a character property value of CHAR in TABLE.
397 425
398(defun unidata-put-symbol (char val table) 426(defun unidata-put-symbol (char val table)
@@ -416,6 +444,19 @@ Property value is a character."
416 (funcall (char-table-extra-slot table 1) char current-val table)) 444 (funcall (char-table-extra-slot table 1) char current-val table))
417 (aset table char val)))) 445 (aset table char val))))
418 446
447;; Store VAL (integer or float) as a character property value of CHAR
448;; in TABLE.
449
450(defun unidata-put-numeric (char val table)
451 (or (numberp val)
452 (not val)
453 (error "Not a number nor nil: %S" val))
454 (let ((current-val (aref table char)))
455 (unless (equal current-val val)
456 (if (stringp current-val)
457 (funcall (char-table-extra-slot table 1) char current-val table))
458 (aset table char val))))
459
419;; Encode the character property value VAL into an integer value by 460;; Encode the character property value VAL into an integer value by
420;; VAL-LIST. By side effect, VAL-LIST is modified. 461;; VAL-LIST. By side effect, VAL-LIST is modified.
421;; VAL-LIST has this form: 462;; VAL-LIST has this form:
@@ -425,7 +466,7 @@ Property value is a character."
425;; (t (VAL . (1+ VAL-CODE1)) (VAL1 . VAL-CODE1) (VAL2 . VAL-CODE2) ...) 466;; (t (VAL . (1+ VAL-CODE1)) (VAL1 . VAL-CODE1) (VAL2 . VAL-CODE2) ...)
426 467
427(defun unidata-encode-val (val-list val) 468(defun unidata-encode-val (val-list val)
428 (let ((slot (assq val val-list)) 469 (let ((slot (assoc val val-list))
429 val-code) 470 val-code)
430 (if slot 471 (if slot
431 (cdr slot) 472 (cdr slot)
@@ -519,6 +560,22 @@ Property value is a character."
519 (set-char-table-extra-slot table 2 (symbol-function 'unidata-put-integer)) 560 (set-char-table-extra-slot table 2 (symbol-function 'unidata-put-integer))
520 table)) 561 table))
521 562
563(defun unidata-gen-table-numeric (prop)
564 (let ((table (unidata-gen-table prop
565 #'(lambda (x)
566 (if (string-match "/" x)
567 (/ (float (string-to-number x))
568 (string-to-number
569 (substring x (match-end 0))))
570 (if (> (length x) 0)
571 (string-to-number x))))
572 t)))
573 (byte-compile 'unidata-get-numeric)
574 (byte-compile 'unidata-put-numeric)
575 (set-char-table-extra-slot table 1 (symbol-function 'unidata-get-numeric))
576 (set-char-table-extra-slot table 2 (symbol-function 'unidata-put-numeric))
577 table))
578
522 579
523;; WORD-LIST TABLE 580;; WORD-LIST TABLE
524 581