X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fchise-subr.el;h=a9dce30d816b2e853e6f0888a3b5063b4b628737;hb=8aa4d398e4b060936a1f82a68fd2456f8e666860;hp=c62e042aebe45f6860d15ec4988e6c4c90d44642;hpb=bc677481b78427fc93a29f41236d32a51d929e14;p=chise%2Fxemacs-chise.git- diff --git a/lisp/utf-2000/chise-subr.el b/lisp/utf-2000/chise-subr.el index c62e042..a9dce30 100644 --- a/lisp/utf-2000/chise-subr.el +++ b/lisp/utf-2000/chise-subr.el @@ -42,6 +42,13 @@ 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 ;;; @@ -56,6 +63,17 @@ (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) @@ -93,7 +111,7 @@ ) ((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 @@ -107,10 +125,64 @@ ((< 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))