;;; chise-subr.el --- basic lisp subroutines for XEmacs CHISE
;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009,
-;; 2010, 2011, 2012, 2013 MORIOKA Tomohiko.
+;; 2010, 2011, 2012, 2013, 2014, 2015, 2016 MORIOKA Tomohiko.
;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE.
;; (unless (memq domain dest)
;; (push domain dest))))))
;; (sort dest #'string<))
- '(ucs ucs/compat daikanwa cns gt jis jis/alt jis/a jis/b
+ '(ucs ucs/compat daikanwa cns gt jis jis/a jis/b
jis-x0212 jis-x0213 cdp shinjigen
r030 r140 misc unknown))
(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))
(<= 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))
(and (<= charset-id-=>>adobe-japan1-0 id)
(<= id charset-id-=>>adobe-japan1-6))
))
(cond
((= a-ir 177)
t)
+ ((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))
nil)
(cond
((= b-ir 177)
nil)
+ ((eq ka '=mj)
+ t)
+ ((eq ka '==mj)
+ t)
+ ((eq ka '=>>mj)
+ t)
((and (setq a-id (charset-id ka))
(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))
(charset-id-adobe-japan1-p a-id))
- (if (and (setq b-id (charset-id kb))
- (charset-id-adobe-japan1-p b-id))
- (< a-id b-id)
- t))
+ (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))
(charset-id-adobe-japan1-p b-id))
nil)
(defun char-ucs (char)
"Return code-point of UCS."
(or (encode-char char '=ucs 'defined-only)
+ (char-feature char '=ucs)
(char-feature char '=>ucs)))
;;;###autoload
(get-char-attribute (car rest) '->denotational)
(get-char-attribute (car rest) '->identical)))
(unless ignore-sisters
- (setq rest (append rest
- (get-char-attribute (car rest) '<-subsumptive)
- (get-char-attribute (car rest) '<-denotational)))))
+ (setq rest
+ (append rest
+ (if (setq ret (get-char-attribute
+ (car rest) '<-subsumptive))
+ (list ret))
+ (if (setq ret (get-char-attribute
+ (car rest) '<-denotational))
+ (list ret))
+ ))))
(setq rest (cdr rest))))))