From bb963ef59d8854a32dbce271350be1c4906939a4 Mon Sep 17 00:00:00 2001 From: tomo Date: Thu, 8 Jan 2004 16:53:16 +0000 Subject: [PATCH] (total-strokes-string<): New function. --- lisp/utf-2000/ideograph-util.el | 39 ++++++++++++++++++++++++++++++++------- 1 file changed, 32 insertions(+), 7 deletions(-) diff --git a/lisp/utf-2000/ideograph-util.el b/lisp/utf-2000/ideograph-util.el index a5c9702..c435990 100644 --- a/lisp/utf-2000/ideograph-util.el +++ b/lisp/utf-2000/ideograph-util.el @@ -1,24 +1,24 @@ ;;; ideograph-util.el --- Ideographic Character Database utility -;; Copyright (C) 1999,2000,2001,2002,2003 MORIOKA Tomohiko. +;; Copyright (C) 1999,2000,2001,2002,2003,2004 MORIOKA Tomohiko. ;; Author: MORIOKA Tomohiko -;; Keywords: UTF-2000, ISO/IEC 10646, Unicode, UCS-4, MULE. +;; Keywords: CHISE, Chaon model, ISO/IEC 10646, Unicode, UCS-4, MULE. -;; This file is part of XEmacs UTF-2000. +;; This file is part of XEmacs CHISE. -;; XEmacs UTF-2000 is free software; you can redistribute it and/or +;; 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 UTF-2000 is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; 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 UTF-2000; see the file COPYING. If not, write to +;; 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. @@ -403,6 +403,31 @@ char))) 'ideographic-structure))) +;;;###autoload +(defun total-strokes-string< (string1 string2 &optional preferred-domains) + (let ((len1 (length string1)) + (len2 (length string2)) + len + (i 0) + c1 c2 + s1 s2) + (setq len (min len1 len2)) + (catch 'tag + (while (< i len) + (setq c1 (aref string1 i) + c2 (aref string2 i)) + (setq s1 (or (char-total-strokes c1 preferred-domains) + 0) + s2 (or (char-total-strokes c2 preferred-domains) + 0)) + (cond ((< s1 s2) + (throw 'tag t)) + ((> s1 s2) + (throw 'tag nil))) + (setq i (1+ i))) + (< len1 len2)))) + + (provide 'ideograph-util) ;;; ideograph-util.el ends here -- 1.7.10.4