1 ;;; ids.el --- Parser and utility for Ideographic Description Sequence.
3 ;; Copyright (C) 2001, 2002, 2003, 2005, 2020 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
6 ;; Keywords: IDS, IDC, Ideographs, UCS, Unicode
8 ;; This file is a part of CHISE-IDS.
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; Ideographic Description Sequence (IDS) is defined in ISO/IEC
28 ;; 10646-1:2000 Annex F.
32 (require 'ideograph-util)
35 (defun ideographic-structure-find-char (structure)
36 (car (ideographic-structure-find-chars structure))
37 ;; (dolist (product (char-feature (nth 1 structure) 'ideographic-products))
38 ;; (if (equal structure
39 ;; (char-feature product 'ideographic-structure))
43 (defun ids-parse-terminal (string)
44 (if (>= (length string) 1)
45 (let* ((chr (aref string 0))
46 (ucs (encode-char chr '=ucs 'defined-only))
48 (unless (or (and ucs (<= #x2FF0 ucs)(<= ucs #x2FFF))
49 (memq (encode-char chr '=ucs-var-001)
51 (memq (encode-char chr '=ucs-itaiji-001)
52 '(#x2FF1 #x2FF9 #x2FF6 #x2FFB))
53 (memq (encode-char chr '=ucs-itaiji-002)
56 (if (and ucs (<= #xE000 ucs)(<= ucs #xF8FF)
57 (setq big5 (encode-char chr 'chinese-big5)))
58 (setq chr (decode-char '=big5-cdp big5)))
60 (substring string 1))))))
62 (defun ids-parse-op-2 (string)
63 (if (>= (length string) 1)
64 (let* ((chr (aref string 0))
65 (ucs (encode-char chr '=ucs 'defined-only)))
69 (and (<= #x2FF4 ucs)(<= ucs #x2FFB))))
70 (memq (encode-char chr '=ucs-var-001)
72 (memq (encode-char chr '=ucs-itaiji-001)
73 '(#x2FF1 #x2FF9 #x2FF6 #x2FFB))
74 (memq (encode-char chr '=ucs-itaiji-002)
78 (substring string 1))))))
80 (defun ids-parse-op-3 (string)
81 (if (>= (length string) 1)
82 (let ((chr (aref string 0)))
83 (if (memq chr '(?\u2FF2 ?\u2FF3))
85 (substring string 1))))))
87 (defun ids-parse-component (string simplify)
88 (let ((ret (ids-parse-element string simplify))
93 (setq rret (ideographic-structure-find-char
94 (cdr (assq 'ideographic-structure (car ret))))))
98 (defun ids-parse-element (string simplify)
99 (let (ret op arg1 arg2 arg3)
100 (cond ((ids-parse-terminal string))
101 ((setq ret (ids-parse-op-2 string))
103 (when (setq ret (ids-parse-component (cdr ret) simplify))
104 (setq arg1 (car ret))
105 (when (setq ret (ids-parse-component (cdr ret) simplify))
106 (setq arg2 (car ret))
107 (cons (list (list 'ideographic-structure op arg1 arg2))
109 ((setq ret (ids-parse-op-3 string))
111 (when (setq ret (ids-parse-component (cdr ret) simplify))
112 (setq arg1 (car ret))
113 (when (setq ret (ids-parse-component (cdr ret) simplify))
114 (setq arg2 (car ret))
115 (when (setq ret (ids-parse-component (cdr ret) simplify))
116 (setq arg3 (car ret))
117 (cons (list (list 'ideographic-structure op arg1 arg2 arg3))
121 (defun ids-parse-string (ids-string &optional simplify)
122 "Parse IDS-STRING and return the result."
123 (let ((ret (ids-parse-element ids-string simplify)))
124 (if (= (length (cdr ret)) 0)
127 ;; (defun ids-format-unit (ids-char)
129 ;; (cond ((characterp ids-char)
130 ;; (char-to-string ids-char))
131 ;; ((integerp ids-char)
132 ;; (char-to-string (decode-char 'ucs ids-char)))
133 ;; ((setq ret (find-char ids-char))
134 ;; (char-to-string ret))
135 ;; ((setq ret (assq 'ideographic-structure ids-char))
136 ;; (ids-format-list (cdr ret))))))
139 ;; (defun ids-format-list (ids-list)
140 ;; "Format ideographic-structure IDS-LIST as an IDS-string."
141 ;; (mapconcat (lambda (cell)
143 ;; (if (char-ref-p cell)
144 ;; (plist-get cell :char)
148 (define-obsolete-function-alias
149 'ids-format-list 'ideographic-structure-to-ids)