((symbolp kb)
nil)))
-(defun char-db-insert-char-ref (char &optional readable column)
+(defun char-db-insert-char-spec (char &optional readable column)
(unless column
(setq column (current-column)))
- (let (char-ref ret al cal key)
+ (let (char-spec ret al cal key)
(cond ((characterp char)
(cond ((setq ret (get-char-attribute char 'ucs))
- (setq char-ref (list (cons 'ucs ret)))
+ (unless (and (<= #xE000 ret)(<= ret #xF8FF))
+ (setq char-spec (list (cons 'ucs ret))))
+ (if (setq ret (get-char-attribute char 'chinese-big5-cdp))
+ (setq char-spec (cons (cons 'chinese-big5-cdp ret)
+ char-spec)))
(if (setq ret (get-char-attribute char 'name))
- (setq char-ref (cons (cons 'name ret) char-ref)))
+ (setq char-spec (cons (cons 'name ret) char-spec)))
)
((setq ret (split-char char))
- (setq char-ref (list ret))
+ (setq char-spec (list ret))
(dolist (ccs (delq (car ret) (charset-list)))
(if (and (>= (charset-iso-final-char ccs) ?0)
(setq ret (get-char-attribute char ccs)))
- (setq char-ref (cons (cons ccs ret) char-ref))))
+ (setq char-spec (cons (cons ccs ret) char-spec))))
(if (setq ret (get-char-attribute char 'name))
- (setq char-ref (cons (cons 'name ret) char-ref)))
+ (setq char-spec (cons (cons 'name ret) char-spec)))
)))
((consp char)
- (setq char-ref char)
+ (setq char-spec char)
(setq char nil)))
(if (or char
(setq char (condition-case nil
- (define-char char-ref)
+ (find-char char-spec)
(error nil))))
(progn
(setq al nil
cal nil)
- (while char-ref
- (setq key (car (car char-ref)))
+ (while char-spec
+ (setq key (car (car char-spec)))
(if (find-charset key)
(setq cal (cons key cal))
(setq al (cons key al)))
- (setq char-ref (cdr char-ref)))
+ (setq char-spec (cdr char-spec)))
(insert-char-attributes char
readable
(or al 'none) cal))
- (insert (prin1-to-string char-ref)))))
+ (insert (prin1-to-string char-spec)))))
(defun char-db-insert-alist (alist &optional readable column)
(unless column
(cond ((eq name 'char)
(insert "(char . ")
(if (setq ret (condition-case nil
- (define-char value)
+ (find-char value)
(error nil)))
(progn
(setq al nil
(if (and (consp cell)
(consp (car cell))
(setq ret (condition-case nil
- (define-char cell)
+ (find-char cell)
(error nil)))
)
(progn
(setq alist (cdr alist))))
(insert ")"))
-(defun char-db-insert-char-map (plist &optional readable column)
+(defun char-db-insert-char-reference (plist &optional readable column)
(unless column
(setq column (current-column)))
(let ((line-breaking
(setq value (pop plist))
(cond ((eq name :char)
(insert ":char\t")
- (char-db-insert-char-ref value readable)
+ (if (numberp value)
+ (setq value (decode-char 'ucs value)))
+ (char-db-insert-char-spec value readable)
(insert line-breaking))
(t
(insert (format "%s\t%S%s"
(defun char-db-decode-isolated-char (ccs code-point)
(let (ret)
(setq ret
- (if (and (memq ccs '(ideograph-gt-pj-1
- ideograph-gt-pj-2
- ideograph-gt-pj-3
- ideograph-gt-pj-4
- ideograph-gt-pj-5
- ideograph-gt-pj-6
- ideograph-gt-pj-7
- ideograph-gt-pj-8
- ideograph-gt-pj-9
- ideograph-gt-pj-10
- ideograph-gt-pj-11))
- (setq ret (decode-char ccs code-point))
- (setq ret (get-char-attribute ret 'ideograph-gt)))
- (decode-builtin-char 'ideograph-gt ret)
- (decode-builtin-char ccs code-point)))
+ (cond ((eq ccs 'arabic-iso8859-6)
+ (decode-char ccs code-point))
+ ((and (memq ccs '(ideograph-gt-pj-1
+ ideograph-gt-pj-2
+ ideograph-gt-pj-3
+ ideograph-gt-pj-4
+ ideograph-gt-pj-5
+ ideograph-gt-pj-6
+ ideograph-gt-pj-7
+ ideograph-gt-pj-8
+ ideograph-gt-pj-9
+ ideograph-gt-pj-10
+ ideograph-gt-pj-11))
+ (setq ret (decode-char ccs code-point))
+ (setq ret (get-char-attribute ret 'ideograph-gt)))
+ (decode-builtin-char 'ideograph-gt ret))
+ (t
+ (decode-builtin-char ccs code-point))))
(cond ((and (<= 0 (char-int ret))
(<= (char-int ret) #x1F))
(decode-char 'ucs (+ #x2400 (char-int ret))))
?\u2421)
(t ret))))
+(defvar char-db-convert-obsolete-format t)
+
(defun insert-char-attributes (char &optional readable
attributes ccs-attributes
column)
(when (and (memq 'name attributes)
(setq value (get-char-attribute char 'name)))
(insert (format
- (if (> (length value) 47)
+ (if (> (+ (current-column) (length value)) 48)
"(name . %S)%s"
"(name . %S)%s")
value line-breaking))
)
(when (and (memq '->ucs attributes)
(setq value (get-char-attribute char '->ucs)))
- (insert (format "(=>ucs\t\t. #x%04X)\t; %c%s"
+ (insert (format (if char-db-convert-obsolete-format
+ "(=>ucs\t\t. #x%04X)\t; %c%s"
+ "(->ucs\t\t. #x%04X)\t; %c%s")
value (decode-char 'ucs value)
line-breaking))
(setq attributes (delq '->ucs attributes))
->fullwidth <-fullwidth
->vulgar-ideograph <-vulgar-ideograph
->ancient-ideograph <-ancient-ideograph
+ ->original-ideograph <-original-ideograph
+ ->simplified-ideograph <-simplified-ideograph
+ ->wrong-ideograph <-wrong-ideograph
->same-ideograph
- ->bopomofo))
+ ->ideographic-variants
+ ->synonyms
+ ->radical <-radical
+ ->bopomofo <-bopomofo
+ ->ideographic <-ideographic
+ ideographic-structure))
(insert (format "(%-18s%s " name line-breaking))
(setq lbs (concat "\n" (make-string (current-column) ?\ ))
separator nil)
(cond ((characterp cell)
(if separator
(insert lbs))
- (char-db-insert-char-ref cell readable)
+ (char-db-insert-char-spec cell readable)
(setq separator lbs))
((consp cell)
(if separator
(insert lbs))
(if (consp (car cell))
- (char-db-insert-char-ref cell readable)
- (char-db-insert-char-map cell readable))
+ (char-db-insert-char-spec cell readable)
+ (char-db-insert-char-reference cell readable))
(setq separator lbs))
(t
(if separator
(if (and (consp cell)
(consp (car cell))
(setq ret (condition-case nil
- (define-char cell)
+ (find-char cell)
(error nil))))
(progn
(setq rest cell
(if ucs
(delete char (char-variants (int-char ucs)))))))
variant vs)
+ (setq variants (sort variants #'<))
(while variants
(setq variant (car variants))
(if (and (or (null script)