X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=ids.el;h=c793a24911b207761c017930dfc2c6ac72e958e3;hb=1d5e08174bad3de8a8c0091496b30d6272c8ff37;hp=dc064be2221acecb5f640adf5dad4f5885d435a4;hpb=06880fbab729fc80806f6ca4e3fed4201c44f0cf;p=chise%2Fids.git diff --git a/ids.el b/ids.el index dc064be..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 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 @@ -29,25 +29,51 @@ ;;; Code: +(require 'ideograph-util) +(require 'ids-find) + +(defun ideographic-structure-find-char (structure) + (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 (get-char-attribute chr 'ucs)) + (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 (get-char-attribute chr 'chinese-big5))) - (setq chr (decode-char 'chinese-big5-cdp big5))) + (setq big5 (encode-char chr 'chinese-big5))) + (setq chr (decode-char '=big5-cdp big5))) (cons chr (substring string 1)))))) (defun ids-parse-op-2 (string) (if (>= (length string) 1) (let* ((chr (aref string 0)) - (ucs (get-char-attribute chr 'ucs))) - (if (or (eq ucs #x2FF0) - (eq ucs #x2FF1) - (and (<= #x2FF4 ucs)(<= ucs #x2FFB))) + (ucs (encode-char chr '=ucs 'defined-only))) + (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))))))