(setq i (1+ i))))
(concat dest (substring filename base len))))
- (when (or load-ignore-elc-files
- (not (file-exists-p system-char-database-directory)))
+ (cond
+ ((or load-ignore-elc-files
+ (not (file-exists-p system-char-database-directory)))
(if (file-exists-p system-char-database-directory)
(delete-file-with-children system-char-database-directory))
(save-char-attribute-table attribute))
(dolist (ccs (charset-list))
- (save-charset-mapping-table ccs)))
-
- (mapcar (lambda (file)
- (reset-char-attribute-table
- (intern (file-name-char-attribute-name file))))
- (directory-files
- (expand-file-name "system-char-id"
- system-char-database-directory)
- nil nil t t))
- )
+ (save-charset-mapping-table ccs))
+ )
+ (t
+ (mapcar (lambda (file)
+ (mount-char-attribute-table
+ (intern (file-name-char-attribute-name file))))
+ (directory-files
+ (expand-file-name "system-char-id"
+ system-char-database-directory)
+ nil nil t t))
+ (dolist (ccs (charset-list))
+ (reset-charset-mapping-table ccs))
+ )))
(t
(load "dumped-chars.el")
(dolist (file system-char-db-source-file-list)
(pureload file))
))
+(defun char-ref= (cr1 cr2 &optional tester)
+ (cond ((char-ref-p cr1)
+ (if (char-ref-p cr2)
+ (char-spec= (plist-get cr1 :char)
+ (plist-get cr2 :char) tester)
+ (char-spec= (plist-get cr1 :char) cr2 tester)))
+ (t
+ (char-spec= cr1
+ (if (char-ref-p cr2)
+ (plist-get cr2 :char)
+ cr2)
+ tester))))
+
+(defun char-spec= (cs1 cs2 &optional tester)
+ (unless tester
+ (setq tester #'eq))
+ (if (characterp cs1)
+ (if (characterp cs2)
+ (funcall tester cs1 cs2)
+ (funcall tester cs1 (find-char cs2)))
+ (if (characterp cs2)
+ (funcall tester (find-char cs1) cs2)
+ (funcall tester (find-char cs1) (find-char cs2)))))
+
+(let (ret)
+ (map-char-attribute
+ (lambda (c dc)
+ (if (consp dc)
+ (setq dc (car dc)))
+ (if (listp dc)
+ (if (setq ret (find-char dc))
+ (setq dc ret)))
+ (when (characterp dc)
+ (setq ret (get-char-attribute dc '->uppercase))
+ (if (if (listp ret)
+ (member* c ret :test #'char-ref=)
+ (char-ref= c ret))
+ (put-case-table-pair c dc (standard-case-table))))
+ nil)
+ '->lowercase))
+
(garbage-collect)
;;; update-cdb.el ends here