X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=ids.el;h=c793a24911b207761c017930dfc2c6ac72e958e3;hb=dbc7f4e9dd1eac798862616e9bdf720987ac903e;hp=8214e834e8ab8e9ccc434e6daec2b1d7c76ded08;hpb=cfae539e7ea9bf015d7e2c6a804579f7aaa656d1;p=chise%2Fids.git diff --git a/ids.el b/ids.el index 8214e83..c793a24 100644 --- a/ids.el +++ b/ids.el @@ -1,11 +1,11 @@ ;;; ids.el --- Parser and utility for Ideographic Description Sequence. -;; Copyright (C) 2001,2002,2003,2005 MORIOKA Tomohiko +;; Copyright (C) 2001, 2002, 2003, 2005, 2020, 2021 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko ;; Keywords: IDS, IDC, Ideographs, 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 @@ -30,19 +30,29 @@ ;;; Code: (require 'ideograph-util) +(require 'ids-find) (defun ideographic-structure-find-char (structure) - (dolist (product (char-feature (nth 1 structure) 'ideographic-products)) - (if (equal structure - (char-feature product 'ideographic-structure)) - (return product)))) + (car (ideographic-structure-find-chars structure)) + ;; (dolist (product (char-feature (nth 1 structure) 'ideographic-products)) + ;; (if (equal structure + ;; (char-feature product 'ideographic-structure)) + ;; (return product))) + ) (defun ids-parse-terminal (string) (if (>= (length string) 1) (let* ((chr (aref string 0)) (ucs (encode-char chr '=ucs 'defined-only)) big5) - (unless (and ucs (<= #x2FF0 ucs)(<= ucs #x2FFF)) + (unless (or (and ucs (<= #x2FF0 ucs)(<= ucs #x2FFF)) + (memq (encode-char chr '=ucs-var-001) + '(#x2FF0)) + (memq (encode-char chr '=ucs-itaiji-001) + '(#x2FF1 #x2FF9 #x2FF6 #x2FFB)) + (memq (encode-char chr '=ucs-itaiji-002) + '(#x2FF1)) + ) (if (and ucs (<= #xE000 ucs)(<= ucs #xF8FF) (setq big5 (encode-char chr 'chinese-big5))) (setq chr (decode-char '=big5-cdp big5))) @@ -53,9 +63,17 @@ (if (>= (length string) 1) (let* ((chr (aref string 0)) (ucs (encode-char chr '=ucs 'defined-only))) - (if (or (eq ucs #x2FF0) - (eq ucs #x2FF1) - (and (<= #x2FF4 ucs)(<= ucs #x2FFB))) + (if (or (and ucs + (or (eq ucs #x2FF0) + (eq ucs #x2FF1) + (and (<= #x2FF4 ucs)(<= ucs #x2FFB)))) + (memq (encode-char chr '=ucs-var-001) + '(#x2FF0)) + (memq (encode-char chr '=ucs-itaiji-001) + '(#x2FF1 #x2FF9 #x2FF6 #x2FFB)) + (memq (encode-char chr '=ucs-itaiji-002) + '(#x2FF1)) + ) (cons chr (substring string 1))))))