From: tomo <tomo>
Date: Mon, 31 May 2010 03:05:29 +0000 (+0000)
Subject: New file.
X-Git-Tag: chise-base-0_25^20~25
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=e6760664a726ba310f6a1b7a5ea9196e201a5151;p=chise%2Fxemacs-chise.git-

New file.
---

diff --git a/lisp/utf-2000/chise-subr.el b/lisp/utf-2000/chise-subr.el
new file mode 100644
index 0000000..030c6d6
--- /dev/null
+++ b/lisp/utf-2000/chise-subr.el
@@ -0,0 +1,103 @@
+;;; chise-subr.el --- basic lisp subroutines for XEmacs CHISE
+
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;;   2007, 2008, 2009, 2010 MORIOKA Tomohiko.
+
+;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE.
+
+;; This file is part of XEmacs CHISE.
+
+;; XEmacs CHISE is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; XEmacs CHISE is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs CHISE; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+;;;###autoload
+(defun char-attribute-name< (ka kb)
+  (cond
+   ((eq '->denotational kb)
+    t)
+   ((eq '->subsumptive kb)
+    (not (eq '->denotational ka)))
+   ((eq '->denotational ka)
+    nil)
+   ((eq '->subsumptive ka)
+    nil)
+   ((and (symbolp ka)
+	 (string-match "^->" (symbol-name ka)))
+    (cond ((and (symbolp kb)
+		(string-match "^->" (symbol-name kb)))
+	   (string< (symbol-name ka)
+		    (symbol-name kb))
+	   ))
+    )
+   ((and (symbolp kb)
+	 (string-match "^->" (symbol-name kb)))
+    t)
+   ((and (symbolp ka)
+	 (string-match "^<-" (symbol-name ka)))
+    (cond ((symbolp kb)
+	   (cond ((string-match "^<-" (symbol-name kb))
+		  (string< (symbol-name ka)
+			   (symbol-name kb))
+		  )
+                 ;; ((string-match "^->" (symbol-name kb))
+                 ;;  t)
+		 )))
+    )
+   ((and (symbolp kb)
+	 (string-match "^<-" (symbol-name kb)))
+    t
+    ;; (not (string-match "^->" (symbol-name ka)))
+    )
+   ((find-charset ka)
+    (if (find-charset kb)
+	(let (a-ir b-ir)
+	  (if (setq a-ir (charset-property ka 'iso-ir))
+	      (if (setq b-ir (charset-property kb 'iso-ir))
+		  (cond
+		   ((= a-ir b-ir)
+		    (< (charset-id ka)(charset-id kb))
+		    )
+		   ((= a-ir 177)
+		    t)
+		   ((= b-ir 177)
+		    nil)
+		   ((< a-ir
+		       b-ir)
+		    ))
+		t)
+	    (if (charset-property kb 'iso-ir)
+		nil
+	      (< (charset-id ka)(charset-id kb)))))
+      nil)
+    )
+   ((find-charset kb))
+   ((symbolp ka)
+    (cond ((symbolp kb)
+	   (string< (symbol-name ka)
+		    (symbol-name kb)))
+	  (t)))
+   ((symbolp kb)
+    nil)))
+
+
+;;; @ end
+;;;
+
+(provide 'chise-subr)
+
+;;; chise-subr.el ends here