X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=ids.el;h=ff19961f816eadc29e585fca3246ef4bcb617e48;hb=2f0e3484341b7291a3a6408e7958acb1c1ac3272;hp=1ae8464d350e5140035694abc9cd7d59a8fc7b96;hpb=80a720af50b108d65d75b35b33d5ed49b2fa269e;p=chise%2Fids.git diff --git a/ids.el b/ids.el index 1ae8464..ff19961 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 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,45 @@ ;;; 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) + '(#x2FF9 #x2FF6))) (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) + '(#x2FF9 #x2FF6))) (cons chr (substring string 1)))))) @@ -98,27 +118,29 @@ (if (= (length (cdr ret)) 0) (car ret)))) -(defun ids-format-unit (ids-char) - (let (ret) - (cond ((characterp ids-char) - (char-to-string ids-char)) - ((integerp ids-char) - (char-to-string (decode-char 'ucs ids-char))) - ((setq ret (find-char ids-char)) - (char-to-string ret)) - ((setq ret (assq 'ideographic-structure ids-char)) - (ids-format-list (cdr ret)))))) - -;;;###autoload -(defun ids-format-list (ids-list) - "Format ideographic-structure IDS-LIST as an IDS-string." - (mapconcat (lambda (cell) - (ids-format-unit - (if (char-ref-p cell) - (plist-get cell :char) - cell))) - ids-list "")) +;; (defun ids-format-unit (ids-char) +;; (let (ret) +;; (cond ((characterp ids-char) +;; (char-to-string ids-char)) +;; ((integerp ids-char) +;; (char-to-string (decode-char 'ucs ids-char))) +;; ((setq ret (find-char ids-char)) +;; (char-to-string ret)) +;; ((setq ret (assq 'ideographic-structure ids-char)) +;; (ids-format-list (cdr ret)))))) + +;; ;;;###autoload +;; (defun ids-format-list (ids-list) +;; "Format ideographic-structure IDS-LIST as an IDS-string." +;; (mapconcat (lambda (cell) +;; (ids-format-unit +;; (if (char-ref-p cell) +;; (plist-get cell :char) +;; cell))) +;; ids-list "")) +(define-obsolete-function-alias + 'ids-format-list 'ideographic-structure-to-ids) ;;; @ End. ;;;