;;; ids-find.el --- search utility based on Ideographic-structures ;; -*- coding: utf-8-mcs-er -*-
-;; Copyright (C) 2002, 2003, 2005, 2006, 2007, 2017, 2020 MORIOKA Tomohiko
+;; Copyright (C) 2002, 2003, 2005, 2006, 2007, 2017, 2020, 2021
+;; MORIOKA Tomohiko
;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
;; Keywords: Kanji, Ideographs, search, IDS, CHISE, UCS, Unicode
(defun ideographic-character-get-structure (character)
"Return ideographic-structure of CHARACTER.
CHARACTER can be a character or char-spec."
- (let (ret)
- (cond ((characterp character)
- (get-char-attribute character 'ideographic-structure)
- )
- ((setq ret (assq 'ideographic-structure character))
- (cdr ret)
- )
- ((setq ret (find-char character))
- (get-char-attribute ret 'ideographic-structure)
- ))))
+ (mapcar (lambda (cell)
+ (or (and (listp cell)
+ (find-char cell))
+ cell))
+ (let (ret)
+ (cond ((characterp character)
+ (get-char-attribute character 'ideographic-structure)
+ )
+ ((setq ret (assq 'ideographic-structure character))
+ (cdr ret)
+ )
+ ((setq ret (find-char character))
+ (get-char-attribute ret 'ideographic-structure)
+ )))))
;;;###autoload
(defun ideographic-char-match-component (char component)
(setq sub cell)
)))
(setq cell
- (if (setq ret (ideographic-structure-find-chars sub))
- (car ret)
- (list (cons 'ideographic-structure sub))))
+ (cond ((setq ret (ideographic-structure-find-chars sub))
+ (car ret)
+ )
+ ((setq ret (ideographic-structure-compact sub))
+ (list (cons 'ideographic-structure ret))
+ )
+ (t
+ (list (cons 'ideographic-structure sub))))
+ )
))
(setq dest (cons cell dest)))
(nreverse dest)))
(defun ideographic-structure-compare-functional-and-apparent (structure
&optional char
conversion-only)
- (let (enc enc-str enc2-str new-str new-str-c f-res a-res ret)
+ (let (enc enc-str enc2-str enc3-str new-str new-str-c
+ f-res a-res ret code)
(cond
((eq (car structure) ?⿸)
(setq enc (nth 1 structure))
(list
(cond
((characterp (nth 2 enc-str))
- (if (or (eq (encode-char (nth 2 enc-str) '=>ucs@component)
- #x20087)
- (eq (encode-char (nth 2 enc-str) '=>ucs@component)
- #x5382)
- (eq (encode-char (nth 2 enc-str) '=>ucs@component)
+ (if (or (memq (encode-char (nth 2 enc-str) '=>ucs@component)
+ '(#x20087 #x5382 #x4E06))
+ (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
#x4E06)
+ (eq (encode-char (nth 2 enc-str) '=ucs-itaiji-001)
+ #x2E282)
(eq (encode-char (nth 2 enc-str) '=big5-cdp)
#x89CE)
(eq (encode-char (nth 2 enc-str) '=>big5-cdp)
a-res
(list ?⿱ new-str-c (nth 2 enc-str))
320))
+ )
+ ((eq (car enc-str) ?⿰)
+ (unless conversion-only
+ (setq f-res (ids-find-chars-including-ids enc-str)))
+ (setq new-str (list ?⿱
+ (nth 2 structure)
+ (nth 1 enc-str)))
+ (setq new-str-c
+ (if (setq ret (ideographic-structure-find-chars new-str))
+ (car ret)
+ (list (cons 'ideographic-structure new-str))))
+ (if conversion-only
+ (list ?⿰ new-str-c (nth 2 enc-str))
+ (setq a-res (ids-find-chars-including-ids new-str))
+ (list enc
+ f-res
+ new-str-c
+ a-res
+ (list ?⿰ new-str-c (nth 2 enc-str))
+ 330))
))
)
)
(list ?⿱ new-str-c (nth 3 enc-str))
419))
))
- )))
+ )
+ ((eq (car enc-str) ?⿰)
+ (cond
+ ((equal (nth 1 enc-str)(nth 2 enc-str))
+ (unless conversion-only
+ (setq f-res (ids-find-chars-including-ids enc-str)))
+ (setq new-str (list ?⿲
+ (nth 1 enc-str)
+ (nth 2 structure)
+ (nth 2 enc-str)))
+ (setq new-str-c
+ (list (cons 'ideographic-structure new-str)))
+ (if conversion-only
+ new-str
+ (setq a-res (ids-find-chars-including-ids new-str))
+ (list enc
+ f-res
+ new-str-c
+ a-res
+ new-str
+ 421))
+ )
+ (t
+ (unless conversion-only
+ (setq f-res (ids-find-chars-including-ids enc-str)))
+ (setq new-str (list ?⿰
+ (nth 2 structure)
+ (nth 2 enc-str)))
+ (setq new-str-c
+ (if (setq ret (ideographic-structure-find-chars new-str))
+ (car ret)
+ (list (cons 'ideographic-structure new-str))))
+ (if conversion-only
+ (list ?⿰ (nth 1 enc-str) new-str-c)
+ (setq a-res (ids-find-chars-including-ids new-str))
+ (list enc
+ f-res
+ new-str-c
+ a-res
+ (list ?⿰ (nth 1 enc-str) new-str-c)
+ 422))
+ ))
+ ))
+ )
)
((eq (car structure) ?⿶)
(setq enc (nth 1 structure))
(cdr (assq 'ideographic-structure enc))
)))
(cond
- ((eq (car enc-str) ?⿱)
- (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
- (when (and enc2-str
- (eq (car enc2-str) ?⿰))
+ ((eq (car enc-str) ?⿱)
+ (cond
+ ((and (characterp (nth 2 enc-str))
+ (memq (char-ucs (nth 2 enc-str))
+ '(#x9580 #x9B25)))
(unless conversion-only
(setq f-res (ids-find-chars-including-ids enc-str)))
- (setq new-str (list ?⿲
- (nth 1 enc2-str)
- (nth 2 structure)
- (nth 2 enc2-str)))
+ (setq new-str (list ?⿵
+ (nth 2 enc-str)
+ (nth 2 structure)))
(setq new-str-c
(if (setq ret (ideographic-structure-find-chars new-str))
(car ret)
new-str-c
a-res
(list ?⿱ (nth 1 enc-str) new-str-c)
- 611))
+ 601))
)
+ ((and (setq enc2-str (ideographic-character-get-structure (nth 2 enc-str)))
+ (cond
+ ((eq (car enc2-str) ?⿰)
+ (setq code 611)
+ )
+ ((eq (car enc2-str) ?⿲)
+ (setq code 614)
+ )
+ ((and (eq (car enc2-str) ?⿱)
+ (setq enc3-str
+ (ideographic-character-get-structure (nth 2 enc2-str)))
+ (eq (car enc3-str) ?⿰))
+ (setq code 613)
+ )))
+ (unless conversion-only
+ (setq f-res (ids-find-chars-including-ids enc-str)))
+ (setq new-str
+ (cond ((eq code 611)
+ (list ?⿲
+ (nth 1 enc2-str)
+ (nth 2 structure)
+ (nth 2 enc2-str))
+ )
+ ((eq code 613)
+ (list ?⿲
+ (nth 1 enc3-str)
+ (nth 2 structure)
+ (nth 2 enc3-str))
+ )
+ ((eq code 614)
+ (list ?⿲
+ (nth 1 enc2-str)
+ (list (list 'ideographic-structure
+ ?⿱
+ (nth 2 enc2-str)
+ (nth 2 structure)))
+ (nth 3 enc2-str))
+ )))
+ (setq new-str-c
+ (if (setq ret (ideographic-structure-find-chars new-str))
+ (car ret)
+ (list (cons 'ideographic-structure
+ (ideographic-structure-compact new-str)))))
+ (if conversion-only
+ (cond ((or (eq code 611)
+ (eq code 614))
+ (list ?⿱ (nth 1 enc-str) new-str-c)
+ )
+ ((eq code 613)
+ (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
+ ))
+ (setq a-res (ids-find-chars-including-ids new-str))
+ (list enc
+ f-res
+ new-str-c
+ a-res
+ (cond ((or (eq code 611)
+ (eq code 614))
+ (list ?⿱ (nth 1 enc-str) new-str-c)
+ )
+ ((eq code 613)
+ (list ?⿳ (nth 1 enc-str)(nth 1 enc2-str) new-str-c)
+ ))
+ code))
+ ))
)
((eq (car enc-str) ?⿳)
(setq enc2-str (ideographic-character-get-structure (nth 3 enc-str)))
710))
)))
)
+ ((eq (car structure) ?⿺)
+ (setq enc (nth 1 structure))
+ (when (setq enc-str
+ (cond ((characterp enc)
+ (or (get-char-attribute enc 'ideographic-structure)
+ (get-char-attribute enc 'ideographic-structure@apparent))
+ )
+ ((consp enc)
+ (or (cdr (assq 'ideographic-structure enc))
+ (cdr (assq 'ideographic-structure@apparent enc)))
+ )))
+ ;; (setq enc-str
+ ;; (mapcar (lambda (cell)
+ ;; (or (and (listp cell)
+ ;; (find-char cell))
+ ;; cell))
+ ;; enc-str))
+ (cond
+ ((eq (car enc-str) ?⿱)
+ (cond
+ ((and (characterp (nth 1 enc-str))
+ (or (and (eq (char-ucs (nth 1 enc-str)) #x200CA)
+ (setq code 811))
+ (and (eq (char-feature (nth 1 enc-str) '=>iwds-1) 233)
+ (characterp (nth 2 structure))
+ (eq (char-ucs (nth 2 structure)) #x4E36)
+ (setq code 812))))
+ (unless conversion-only
+ (setq f-res (ids-find-chars-including-ids enc-str)))
+ (setq new-str (list ?⿺
+ (nth 1 enc-str)
+ (nth 2 structure)))
+ (setq new-str-c
+ (if (setq ret (ideographic-structure-find-chars new-str))
+ (car ret)
+ (list (cons 'ideographic-structure new-str))))
+ (if conversion-only
+ (list ?⿱ new-str-c (nth 2 enc-str))
+ (setq a-res (ids-find-chars-including-ids new-str))
+ (list enc
+ f-res
+ new-str-c
+ a-res
+ (list ?⿱ new-str-c (nth 2 enc-str))
+ code))
+ )
+ ((and (characterp (nth 2 enc-str))
+ (or (memq (char-ucs (nth 2 enc-str))
+ '(#x4E00
+ #x706C
+ #x65E5 #x66F0 #x5FC3
+ #x2123C #x58EC #x738B #x7389))
+ (memq (encode-char (nth 2 enc-str) '=>ucs@component)
+ '(#x2123C #x58EC))
+ (eq (encode-char (nth 2 enc-str) '=>ucs@iwds-1)
+ #x7389)))
+ (unless conversion-only
+ (setq f-res (ids-find-chars-including-ids enc-str)))
+ (setq new-str (list ?⿰
+ (nth 1 enc-str)
+ (nth 2 structure)))
+ (setq new-str-c
+ (if (setq ret (ideographic-structure-find-chars new-str))
+ (car ret)
+ (list (cons 'ideographic-structure new-str))))
+ (if conversion-only
+ (list ?⿱ new-str-c (nth 2 enc-str))
+ (setq a-res (ids-find-chars-including-ids new-str))
+ (list enc
+ f-res
+ new-str-c
+ a-res
+ (list ?⿱ new-str-c (nth 2 enc-str))
+ 813))
+ )
+ ))))
+ )
((eq (car structure) ?⿻)
(setq enc (nth 1 structure))
(when (setq enc-str