;;; chise-subr.el --- basic lisp subroutines for XEmacs CHISE
;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009,
-;; 2010, 2011, 2012 MORIOKA Tomohiko.
+;; 2010, 2011, 2012, 2013, 2014 MORIOKA Tomohiko.
;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE.
(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))
+;; (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))
+(defun charset-id-adobe-japan1-p (id)
+ (or (and (<= charset-id-=adobe-japan1-0 id)
+ (<= id charset-id-=adobe-japan1-6))
+ (and (<= charset-id-==adobe-japan1-0 id)
+ (<= id charset-id-==adobe-japan1-6))
+ ;; (and (<= charset-id-=>>>adobe-japan1-0 id)
+ ;; (<= id charset-id-=>>>adobe-japan1-6))
+ (and (<= charset-id-=>>adobe-japan1-0 id)
+ (<= id charset-id-=>>adobe-japan1-6))
+ ))
+
;;; @ feature name
;;;
(defun char-attribute-name< (ka kb)
"Return t if symbol KA is less than KB in feature-name sorting order."
(cond
+ ((and (symbolp ka)
+ (eq (aref (symbol-name ka) 0) ?*))
+ (cond ((and (symbolp kb)
+ (eq (aref (symbol-name kb) 0) ?*))
+ (string< (symbol-name ka)
+ (symbol-name kb))
+ ))
+ )
+ ((and (symbolp kb)
+ (eq (aref (symbol-name kb) 0) ?*))
+ t)
((eq '->denotational kb)
t)
((eq '->subsumptive kb)
(cond
((= a-ir 177)
t)
+ ((eq kb '=mj)
+ nil)
+ ((eq kb '==mj)
+ nil)
+ ((eq kb '=>>mj)
+ nil)
((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))
- ))
+ (charset-id-adobe-japan1-p b-id))
nil)
(t)))
(if (setq b-ir (charset-property kb 'iso-ir))
(cond
((= b-ir 177)
nil)
+ ((eq ka '=mj)
+ t)
+ ((eq ka '==mj)
+ t)
+ ((eq ka '=>>mj)
+ t)
((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))
- ))
+ (charset-id-adobe-japan1-p a-id))
t)
(t nil))
(cond
+ ((eq ka '=mj)
+ t)
+ ((eq ka '==mj)
+ t)
+ ((eq ka '=>>mj)
+ t)
((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))
+ (charset-id-adobe-japan1-p a-id))
+ (cond
+ ((eq kb '=mj)
+ nil)
+ ((eq kb '==mj)
+ nil)
+ ((eq kb '=>>mj)
+ nil)
+ ((and (setq b-id (charset-id kb))
+ (charset-id-adobe-japan1-p b-id))
+ (< a-id b-id))
+ (t))
+ )
+ ((eq kb '=mj)
+ nil)
+ ((eq kb '==mj)
+ nil)
+ ((eq kb '=>>mj)
+ nil)
((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))
- ))
+ (charset-id-adobe-japan1-p b-id))
nil)
(t
(< (charset-id ka)(charset-id kb))