From e6760664a726ba310f6a1b7a5ea9196e201a5151 Mon Sep 17 00:00:00 2001 From: tomo Date: Mon, 31 May 2010 03:05:29 +0000 Subject: [PATCH] New file. --- lisp/utf-2000/chise-subr.el | 103 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 103 insertions(+) create mode 100644 lisp/utf-2000/chise-subr.el 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 +;; 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 -- 1.7.10.4