;;; chise-subr.el --- basic lisp subroutines for XEmacs CHISE
;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009,
-;; 2010, 2011 MORIOKA Tomohiko.
+;; 2010, 2011, 2012 MORIOKA Tomohiko.
;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE.
;;; Code:
(defvar char-db-feature-domains
+ ;; (let (dest str len ret domain)
+ ;; (dolist (fn (char-attribute-list))
+ ;; (setq str (symbol-name fn))
+ ;; (when (string-match "^ideographic-radical@\\([^*]+\\)$" str)
+ ;; (setq domain (substring str (match-beginning 1)))
+ ;; (when (> (setq len (length domain)) 0)
+ ;; (setq ret (read-from-string domain))
+ ;; (when (= (cdr ret) len)
+ ;; (setq domain (car ret))
+ ;; (unless (memq domain dest)
+ ;; (push domain dest))))))
+ ;; (sort dest #'string<))
'(ucs ucs/compat daikanwa cns gt jis jis/alt jis/a jis/b
- jis-x0212 jis-x0213 cdp shinjigen misc unknown))
+ jis-x0212 jis-x0213 cdp shinjigen
+ r030 r140 misc unknown))
+
+(defconst charset-id-=adobe-japan1-0 (charset-id '=adobe-japan1-0))
+(defconst charset-id-=adobe-japan1-6 (charset-id '=adobe-japan1-6))
+(defconst charset-id-=>>>adobe-japan1-0 (charset-id '=>>>adobe-japan1-0))
+(defconst charset-id-=>>>adobe-japan1-6 (charset-id '=>>>adobe-japan1-6))
+(defconst charset-id-=>>adobe-japan1-0 (charset-id '=>>adobe-japan1-0))
+(defconst charset-id-=>>adobe-japan1-6 (charset-id '=>>adobe-japan1-6))
;;; @ feature name
)
((find-charset ka)
(if (find-charset kb)
- (let (a-ir b-ir)
+ (let (a-ir b-ir a-id b-id)
(if (setq a-ir (charset-property ka 'iso-ir))
(if (setq b-ir (charset-property kb 'iso-ir))
(cond
((< a-ir
b-ir)
))
- t)
- (if (charset-property kb 'iso-ir)
- nil
- (< (charset-id ka)(charset-id kb)))))
+ (cond
+ ((= a-ir 177)
+ t)
+ ((and (setq b-id (charset-id kb))
+ (or (and (<= charset-id-=adobe-japan1-0 b-id)
+ (<= b-id charset-id-=adobe-japan1-6))
+ (and (<= charset-id-=>>>adobe-japan1-0 b-id)
+ (<= b-id charset-id-=>>>adobe-japan1-6))
+ (and (<= charset-id-=>>adobe-japan1-0 b-id)
+ (<= b-id charset-id-=>>adobe-japan1-6))
+ ))
+ nil)
+ (t)))
+ (if (setq b-ir (charset-property kb 'iso-ir))
+ (cond
+ ((= b-ir 177)
+ nil)
+ ((and (setq a-id (charset-id ka))
+ (or (and (<= charset-id-=adobe-japan1-0 a-id)
+ (<= a-id charset-id-=adobe-japan1-6))
+ (and (<= charset-id-=>>>adobe-japan1-0 a-id)
+ (<= a-id charset-id-=>>>adobe-japan1-6))
+ (and (<= charset-id-=>>adobe-japan1-0 a-id)
+ (<= a-id charset-id-=>>adobe-japan1-6))
+ ))
+ t)
+ (t nil))
+ (cond
+ ((and (setq a-id (charset-id ka))
+ (or (and (<= charset-id-=adobe-japan1-0 a-id)
+ (<= a-id charset-id-=adobe-japan1-6))
+ (and (<= charset-id-=>>>adobe-japan1-0 a-id)
+ (<= a-id charset-id-=>>>adobe-japan1-6))
+ (and (<= charset-id-=>>adobe-japan1-0 a-id)
+ (<= a-id charset-id-=>>adobe-japan1-6))
+ ))
+ (if (and (setq b-id (charset-id kb))
+ (or (and (<= charset-id-=adobe-japan1-0 b-id)
+ (<= b-id charset-id-=adobe-japan1-6))
+ (and (<= charset-id-=>>>adobe-japan1-0 b-id)
+ (<= b-id charset-id-=>>>adobe-japan1-6))
+ (and (<= charset-id-=>>adobe-japan1-0 b-id)
+ (<= b-id charset-id-=>>adobe-japan1-6))
+ ))
+ (< a-id b-id)
+ t))
+ ((and (setq b-id (charset-id kb))
+ (or (and (<= charset-id-=adobe-japan1-0 b-id)
+ (<= b-id charset-id-=adobe-japan1-6))
+ (and (<= charset-id-=>>>adobe-japan1-0 b-id)
+ (<= b-id charset-id-=>>>adobe-japan1-6))
+ (and (<= charset-id-=>>adobe-japan1-0 b-id)
+ (<= b-id charset-id-=>>adobe-japan1-6))
+ ))
+ nil)
+ (t
+ (< (charset-id ka)(charset-id kb))
+ )))))
nil)
)
((find-charset kb))