;;; ids-find.el --- search utility based on Ideographic-structures
-;; Copyright (C) 2002,2003,2005 MORIOKA Tomohiko
+;; Copyright (C) 2002,2003,2005,2006,2007 MORIOKA Tomohiko
;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
;; Keywords: Kanji, Ideographs, search, IDS, CHISE, UCS, Unicode
-;; This file is a part of Tomoyo-Tools.
+;; This file is a part of CHISE IDS.
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
(ids-index-store-char product cell))
((setq ret (assq 'ideographic-structure cell))
(ids-index-store-structure product (cdr ret)))
- ;; ((setq ret (find-char cell))
- ;; (ids-index-store-char product ret))
+ ((setq ret (find-char cell))
+ (ids-index-store-char product ret))
))))
;;;###autoload
(defun char-component-variants (char)
(let ((dest (list char))
ret uchr)
+ (dolist (feature (to-component-features))
+ (if (setq ret (get-char-attribute char feature))
+ (dolist (c ret)
+ (setq dest (union dest (char-component-variants c))))))
(cond
- ((setq ret (some (lambda (feature)
- (get-char-attribute char feature))
- (to-component-features)))
- (dolist (c ret)
- (setq dest (union dest (char-component-variants c))))
- )
+ ;; ((setq ret (some (lambda (feature)
+ ;; (get-char-attribute char feature))
+ ;; (to-component-features)))
+ ;; (dolist (c ret)
+ ;; (setq dest (union dest (char-component-variants c))))
+ ;; )
((setq ret (get-char-attribute char '->ucs-unified))
(setq dest (cons char ret))
(dolist (c dest)
(setq dest (union dest
(some (lambda (feature)
- (get-char-attribute char feature))
+ (get-char-attribute c feature))
(of-component-features))
)))
)
(dolist (c dest)
(setq dest (union dest
(some (lambda (feature)
- (get-char-attribute char feature))
+ (get-char-attribute c feature))
(of-component-features))
)))
)
(m2 (char-ucs c2)))
(or (and m1 m2
(eq m1 m2))
- (some (lambda (feature)
- (some (lambda (b2)
- (unless (characterp b2)
- (setq b2 (find-char b2)))
- (and b2
- (ideographic-structure-char= c1 b2)))
- (char-feature c2 feature)
- ;; (get-char-attribute
- ;; c2 '<-ideographic-component-forms)
- ))
- (of-component-features))
- (progn
- (setq m1 (car (get-char-attribute c1 '<-radical))
- m2 (car (get-char-attribute c2 '<-radical)))
- (unless (characterp m1)
- (setq m1 (find-char m1)))
- (unless (characterp m2)
- (setq m2 (find-char m2)))
- (when (or m1 m2)
- (ideographic-structure-char= m1 m2))))))))
+ (memq c1 (char-component-variants c2))
+ ;; (some (lambda (feature)
+ ;; (some (lambda (b2)
+ ;; (unless (characterp b2)
+ ;; (setq b2 (find-char b2)))
+ ;; (and b2
+ ;; (ideographic-structure-char= c1 b2)))
+ ;; (char-feature c2 feature)
+ ;; ;; (get-char-attribute
+ ;; ;; c2 '<-ideographic-component-forms)
+ ;; ))
+ ;; (of-component-features))
+ ;; (progn
+ ;; (setq m1 (car (get-char-attribute c1 '<-radical))
+ ;; m2 (car (get-char-attribute c2 '<-radical)))
+ ;; (unless (characterp m1)
+ ;; (setq m1 (find-char m1)))
+ ;; (unless (characterp m2)
+ ;; (setq m2 (find-char m2)))
+ ;; (when (or m1 m2)
+ ;; (ideographic-structure-char= m1 m2))
+ ;; )
+ )))))
(defun ideographic-structure-member-compare-components (component s-component)
(let (ret)
&optional level ignored-chars)
(unless level
(setq level 0))
- (let (is dis i as bs)
- (dolist (c (sort (ideographic-products-find components)
+ (let (is i as bs)
+ (dolist (c (sort (copy-tree (ideographic-products-find components))
(lambda (a b)
(if (setq as (char-total-strokes a))
(if (setq bs (char-total-strokes b))