;;; ids-find.el --- search utility based on Ideographic-structures ;; -*- coding: utf-8-mcs-er -*-
-;; Copyright (C) 2002, 2003, 2005, 2006, 2007, 2017, 2020, 2021
+;; Copyright (C) 2002, 2003, 2005, 2006, 2007, 2017, 2020, 2021, 2022, 2023
;; MORIOKA Tomohiko
;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
(put-char-attribute component 'ideographic-products
(cons product ret))
(when (setq ret (char-feature component 'ideographic-structure))
- (ids-index-store-structure product ret)))
+ (ids-index-store-structure product ret))
+ (when (setq ret (char-feature component 'ideographic-structure@apparent))
+ (ids-index-store-structure product ret))
+ (when (setq ret (char-feature component 'ideographic-structure@apparent/leftmost))
+ (ids-index-store-structure product ret))
+ (when (setq ret (char-feature component 'ideographic-structure@apparent/rightmost))
+ (ids-index-store-structure product ret))
+ )
))
(defun ids-index-store-structure (product structure)
(ids-index-store-char product cell))
((setq ret (assq 'ideographic-structure cell))
(ids-index-store-structure product (cdr ret)))
+ ((setq ret (assq 'ideographic-structure@apparent cell))
+ (ids-index-store-structure product (cdr ret)))
+ ((setq ret (assq 'ideographic-structure@apparent/leftmost cell))
+ (ids-index-store-structure product (cdr ret)))
+ ((setq ret (assq 'ideographic-structure@apparent/rightmost cell))
+ (ids-index-store-structure product (cdr ret)))
((setq ret (find-char cell))
(ids-index-store-char product ret))
))))
(ids-index-store-structure c v)
nil)
'ideographic-structure@apparent/leftmost)
+ (map-char-attribute
+ (lambda (c v)
+ (ids-index-store-structure c v)
+ nil)
+ 'ideographic-structure@apparent/rightmost)
+ (let (products ucs)
+ (map-char-attribute
+ (lambda (c v)
+ (setq products (get-char-attribute c 'ideographic-products))
+ (dolist (comp (delq c (char-ucs-chars c)))
+ (dolist (p_c (get-char-attribute comp 'ideographic-products))
+ (unless (encode-char p_c '=ucs)
+ (if (setq ucs (char-ucs p_c))
+ (setq p_c (decode-char '=ucs ucs))))
+ (setq products (adjoin p_c products))))
+ (put-char-attribute c 'ideographic-products products)
+ nil)
+ '=>iwds-1)
+ (map-char-attribute
+ (lambda (c v)
+ (setq products (get-char-attribute c 'ideographic-products))
+ (dolist (comp (delq c (char-ucs-chars c)))
+ (dolist (p_c (get-char-attribute comp 'ideographic-products))
+ (unless (encode-char p_c '=ucs)
+ (if (setq ucs (char-ucs p_c))
+ (setq p_c (decode-char '=ucs ucs))))
+ (setq products (adjoin p_c products))))
+ (put-char-attribute c 'ideographic-products products)
+ nil)
+ '=>ucs@iwds-1)
+ (map-char-attribute
+ (lambda (c v)
+ (setq products (get-char-attribute c 'ideographic-products))
+ (dolist (comp (delq c (char-ucs-chars c)))
+ (put-char-attribute
+ comp 'ideographic-products
+ (union products
+ (get-char-attribute comp 'ideographic-products))))
+ )
+ '=>iwds-1)
+ (map-char-attribute
+ (lambda (c v)
+ (setq products (get-char-attribute c 'ideographic-products))
+ (dolist (comp (delq c (char-ucs-chars c)))
+ (put-char-attribute
+ comp 'ideographic-products
+ (union products
+ (get-char-attribute comp 'ideographic-products))))
+ )
+ '=>ucs@iwds-1)
+ )
(unless in-memory
(save-char-attribute-table 'ideographic-products)))
(ideographic-structure-equal str structure))
(and (setq str
(get-char-attribute pc 'ideographic-structure@apparent/leftmost))
+ (ideographic-structure-equal str structure))
+ (and (setq str
+ (get-char-attribute pc 'ideographic-structure@apparent/rightmost))
(ideographic-structure-equal str structure)))
(setq pl (cons pc pl))
))
ret dest sub)
(while rest
(setq cell (pop rest))
+ (if (and (consp cell)
+ (setq ret (find-char cell)))
+ (setq cell ret))
(cond
((and (consp cell)
(cond ((setq ret (assq 'ideographic-structure cell))
(cond ((characterp enc)
(or (get-char-attribute enc 'ideographic-structure)
(get-char-attribute enc 'ideographic-structure@apparent)
- (get-char-attribute enc 'ideographic-structure@apparent/leftmost))
+ (get-char-attribute enc 'ideographic-structure@apparent/leftmost)
+ (get-char-attribute enc 'ideographic-structure@apparent/rightmost))
)
((consp enc)
(or (cdr (assq 'ideographic-structure enc))
(cdr (assq 'ideographic-structure@apparent enc))
- (cdr (assq 'ideographic-structure@apparent/leftmost enc)))
+ (cdr (assq 'ideographic-structure@apparent/leftmost enc))
+ (cdr (assq 'ideographic-structure@apparent/rightmost enc)))
)))
;; (setq enc-str
;; (mapcar (lambda (cell)