From 854d4ec4f71e835a0a1530afd60ca434394da401 Mon Sep 17 00:00:00 2001 From: tomo Date: Sat, 28 Sep 2002 07:28:10 +0000 Subject: [PATCH] New file. --- ids-find.el | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 82 insertions(+) create mode 100644 ids-find.el 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 +;; 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 -- 1.7.10.4