lisp/utf-2000/chise-subr.el

   1 ;;; chise-subr.el --- basic lisp subroutines for XEmacs CHISE
   2
   3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
   4 ;;   2007, 2008, 2009, 2010 MORIOKA Tomohiko.
   5
   6 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
   7 ;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE.
   8
   9 ;; This file is part of XEmacs CHISE.
  10
  11 ;; XEmacs CHISE is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; XEmacs CHISE is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with XEmacs CHISE; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Code:
  27
  28 ;;;###autoload
  29 (defun char-attribute-name< (ka kb)
  30   (cond
  31    ((eq '->denotational kb)
  32     t)
  33    ((eq '->subsumptive kb)
  34     (not (eq '->denotational ka)))
  35    ((eq '->denotational ka)
  36     nil)
  37    ((eq '->subsumptive ka)
  38     nil)
  39    ((and (symbolp ka)
  40          (string-match "^->" (symbol-name ka)))
  41     (cond ((and (symbolp kb)
  42                 (string-match "^->" (symbol-name kb)))
  43            (string< (symbol-name ka)
  44                     (symbol-name kb))
  45            ))
  46     )
  47    ((and (symbolp kb)
  48          (string-match "^->" (symbol-name kb)))
  49     t)
  50    ((and (symbolp ka)
  51          (string-match "^<-" (symbol-name ka)))
  52     (cond ((symbolp kb)
  53            (cond ((string-match "^<-" (symbol-name kb))
  54                   (string< (symbol-name ka)
  55                            (symbol-name kb))
  56                   )
  57                  ;; ((string-match "^->" (symbol-name kb))
  58                  ;;  t)
  59                  )))
  60     )
  61    ((and (symbolp kb)
  62          (string-match "^<-" (symbol-name kb)))
  63     t
  64     ;; (not (string-match "^->" (symbol-name ka)))
  65     )
  66    ((find-charset ka)
  67     (if (find-charset kb)
  68         (let (a-ir b-ir)
  69           (if (setq a-ir (charset-property ka 'iso-ir))
  70               (if (setq b-ir (charset-property kb 'iso-ir))
  71                   (cond
  72                    ((= a-ir b-ir)
  73                     (< (charset-id ka)(charset-id kb))
  74                     )
  75                    ((= a-ir 177)
  76                     t)
  77                    ((= b-ir 177)
  78                     nil)
  79                    ((< a-ir
  80                        b-ir)
  81                     ))
  82                 t)
  83             (if (charset-property kb 'iso-ir)
  84                 nil
  85               (< (charset-id ka)(charset-id kb)))))
  86       nil)
  87     )
  88    ((find-charset kb))
  89    ((symbolp ka)
  90     (cond ((symbolp kb)
  91            (string< (symbol-name ka)
  92                     (symbol-name kb)))
  93           (t)))
  94    ((symbolp kb)
  95     nil)))
  96
  97
  98 ;;; @ end
  99 ;;;
 100
 101 (provide 'chise-subr)
 102
 103 ;;; chise-subr.el ends here