;;; Code:
(defun ids-index-store-char (product component)
- (let ((ret (char-feature ; get-char-attribute
+ (let ((ret (get-char-attribute ; char-feature
component 'ideographic-products)))
(unless (memq product ret)
(put-char-attribute component 'ideographic-products
(cons product ret)))
- (when (setq ret (char-feature component 'ideographic-structure))
- (ids-index-store-structure product ret))))
+ ;; (when ret (setq ret (get-char-attribute ; char-feature
+ ;; component 'ideographic-structure))
+ ;; (ids-index-store-structure product ret))
+ ))
(defun ids-index-store-structure (product structure)
(let (ret)
(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
(setq dest (union dest (ids-find-all-products cell))))
dest))
+(defun of-component-features ()
+ (let (dest)
+ (dolist (feature (char-attribute-list))
+ (when (string-match "^<-.*[@/]component\\(/[^*/]+\\)*$"
+ (symbol-name feature))
+ (push feature dest)))
+ (cons '<-ideographic-component-forms
+ dest)))
+
+(defun to-component-features ()
+ (let (dest)
+ (dolist (feature (char-attribute-list))
+ (when (string-match "^->.*[@/]component\\(/[^*/]+\\)*$"
+ (symbol-name feature))
+ (push feature dest)))
+ (cons '->ideographic-component-forms
+ dest)))
+
;;;###autoload
(defun char-component-variants (char)
- (let (dest ret uchr)
+ (let ((dest (list char))
+ ret uchr)
(cond
- ((setq ret (char-feature char '<-ideographic-component-forms))
+ ((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 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
- (get-char-attribute
- c '->ideographic-component-forms))))
+ (some (lambda (feature)
+ (get-char-attribute char feature))
+ (of-component-features))
+ )))
)
((and (setq ret (get-char-attribute char '=>ucs))
(setq uchr (decode-char '=ucs ret)))
(setq dest (cons uchr (char-variants uchr)))
(dolist (c dest)
(setq dest (union dest
- (get-char-attribute
- c '->ideographic-component-forms))))
+ (some (lambda (feature)
+ (get-char-attribute char feature))
+ (of-component-features))
+ )))
)
(t
- (map-char-family (lambda (c)
- (unless (memq c dest)
- (setq dest (cons c dest)))
- (setq dest
- (union dest
- (get-char-attribute
- c '->ideographic-component-forms)))
- nil)
- char)))
+ (map-char-family
+ (lambda (c)
+ (unless (memq c dest)
+ (setq dest (cons c dest)))
+ (setq dest
+ (union dest
+ (some (lambda (feature)
+ (char-feature c feature))
+ (of-component-features))
+ ))
+ nil)
+ char)
+ ))
dest))
;;;###autoload
(m2 (char-ucs c2)))
(or (and m1 m2
(eq m1 m2))
- (some (lambda (b2)
- (unless (characterp b2)
- (setq b2 (find-char b2)))
- (and b2
- (ideographic-structure-char= c1 b2)))
- (get-char-attribute
- c2 '<-ideographic-component-forms))
+ (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)))
(or (ideographic-structure-to-ids v)
v)))
+(defun ids-insert-chars-including-components (components level)
+ (let (is dis i)
+ (dolist (c (ideographic-products-find components))
+ (setq is (char-feature c 'ideographic-structure))
+ ;; to avoid problems caused by wrong indexes
+ (when (every (lambda (cc)
+ (ideographic-structure-member cc is))
+ components)
+ ;;(ids-insert-chars-including-components (char-to-string c) (1+ level))
+ (setq i 0)
+ (while (< i level)
+ (insert "\t")
+ (setq i (1+ i)))
+ (insert (ids-find-format-line c is))
+ ;;(forward-line -1)
+ (ids-insert-chars-including-components
+ (char-to-string c) (1+ level))
+ )
+ )))
+
;;;###autoload
(defun ids-find-chars-including-components (components)
"Search Ideographs whose structures have COMPONENTS."
(with-current-buffer (get-buffer-create ids-find-result-buffer)
(setq buffer-read-only nil)
(erase-buffer)
- (let (is)
- (dolist (c (ideographic-products-find components))
- (setq is (char-feature c 'ideographic-structure))
- ;; to avoid problems caused by wrong indexes
- (when (every (lambda (c)
- (ideographic-structure-member c is))
- components)
- (insert (ids-find-format-line c is))
- )
- )
- ;; (forward-line -1)
- )
+ (ids-insert-chars-including-components components 0)
+ ;; (let (is dis)
+ ;; (dolist (c (ideographic-products-find components))
+ ;; (setq is (char-feature c 'ideographic-structure))
+ ;; ;; to avoid problems caused by wrong indexes
+ ;; ;; (when (every (lambda (cc)
+ ;; ;; (ideographic-structure-member cc is))
+ ;; ;; components)
+ ;; (dolist (dc (ideographic-products-find (char-to-string c)))
+ ;; (setq dis (char-feature dc 'ideographic-structure))
+ ;; ;; ;; to avoid problems caused by wrong indexes
+ ;; ;; (when (every (lambda (dcc)
+ ;; ;; (ideographic-structure-member dcc is))
+ ;; ;; components)
+ ;; (insert "\t")
+ ;; (insert (ids-find-format-line dc dis))
+ ;; (forward-line -1)
+ ;; ;; )
+ ;; )
+ ;; (insert (ids-find-format-line c is))
+ ;; (forward-line -1)
+ ;; ;; )
+ ;; )
+ ;; )
(goto-char (point-min)))
(view-buffer ids-find-result-buffer))
;; (defun ids-find-chars-including-components (components)