From: tomo <tomo>
Date: Sat, 28 Sep 2002 07:28:10 +0000 (+0000)
Subject: New file.
X-Git-Tag: ids-0_0-1~210
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=854d4ec4f71e835a0a1530afd60ca434394da401;p=chise%2Fids.git

New file.
---

diff --git a/ids-find.el b/ids-find.el
new file mode 100644
index 0000000..e68d8a1
--- /dev/null
+++ b/ids-find.el
@@ -0,0 +1,82 @@
+;;; ids-find.el --- search utility based on Ideographic-structures
+
+;; Copyright (C) 2002 MORIOKA Tomohiko
+
+;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
+;; Keywords: Kanji, Ideographs, search, IDS
+
+;; This file is a part of Tomoyo-Tools.
+
+;; This program 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.
+
+;; This program 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 this program; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Code:
+
+(defun ideographic-structure-member-compare-parts (part s-part)
+  (let (ret)
+    (cond ((char-ref= part s-part
+		      (lambda (c1 c2)
+			(or (eq c1 c2)
+			    (and c1 c2
+				 (eq (char-ucs c1)(char-ucs c2)))))))
+	  ((listp s-part)
+	   (if (setq ret (assq 'ideographic-structure s-part))
+	       (ideographic-structure-member part (cdr ret))))
+	  ((setq ret (get-char-attribute s-part 'ideographic-structure))
+	   (ideographic-structure-member part ret)))))
+
+(defun ideographic-structure-member (part structure)
+  (or (progn
+	(setq structure (cdr structure))
+	(ideographic-structure-member-compare-parts part (car structure)))
+      (progn
+	(setq structure (cdr structure))
+	(ideographic-structure-member-compare-parts part (car structure)))
+      (progn
+	(setq structure (cdr structure))
+	(and (car structure)
+	     (ideographic-structure-member-compare-parts
+	      part (car structure))))))
+
+;;;###autoload
+(defun ideographic-structure-search-chars (parts)
+  "Search Ideographs by PARTS."
+  (interactive "sParts : ")
+  (with-current-buffer (get-buffer-create " *ids-chars*")
+    (setq buffer-read-only nil)
+    (erase-buffer)
+    (map-char-attribute
+     (lambda (c v)
+       (when (every
+	      (lambda (p)
+		;; (member* p v :test #'char-ref=)
+		(ideographic-structure-member p v))
+	      parts)
+	 (insert (format "%c\t%s\n"
+			 c
+			 (or (ideographic-structure-to-ids v)
+			     v))))
+       nil)
+     'ideographic-structure)
+    (goto-char (point-min)))
+  (view-buffer " *ids-chars*"))
+
+
+;;; @ End.
+;;;
+
+(provide 'ids-find)
+
+;;; ids-find.el ends here