ids.el

   1 ;;; ids.el --- Parser and utility for Ideographic Description Sequence.
   2
   3 ;; Copyright (C) 2001, 2002, 2003, 2005, 2020, 2021 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
   6 ;; Keywords: IDS, IDC, Ideographs, UCS, Unicode
   7
   8 ;; This file is a part of CHISE-IDS.
   9
  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.
  14
  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.
  19
  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.
  24
  25 ;;; Commentary:
  26
  27 ;; Ideographic Description Sequence (IDS) is defined in ISO/IEC
  28 ;; 10646-1:2000 Annex F.
  29
  30 ;;; Code:
  31
  32 (require 'ideograph-util)
  33 (require 'ids-find)
  34
  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))
  40   ;;       (return product)))
  41   )
  42
  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))
  47              big5)
  48         (unless (or (and ucs (<= #x2FF0 ucs)(<= ucs #x2FFF))
  49                     (memq (encode-char chr '=ucs-var-001)
  50                           '(#x2FF0))
  51                     (memq (encode-char chr '=ucs-itaiji-001)
  52                           '(#x2FF1 #x2FF9 #x2FF6 #x2FFB))
  53                     (memq (encode-char chr '=ucs-itaiji-002)
  54                           '(#x2FF1))
  55                     )
  56           (if (and ucs (<= #xE000 ucs)(<= ucs #xF8FF)
  57                    (setq big5 (encode-char chr 'chinese-big5)))
  58               (setq chr (decode-char '=big5-cdp big5)))
  59           (cons chr
  60                 (substring string 1))))))
  61
  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)))
  66         (if (or (and ucs
  67                      (or (eq ucs #x2FF0)
  68                          (eq ucs #x2FF1)
  69                          (and (<= #x2FF4 ucs)(<= ucs #x2FFB))))
  70                 (memq (encode-char chr '=ucs-var-001)
  71                       '(#x2FF0))
  72                 (memq (encode-char chr '=ucs-itaiji-001)
  73                       '(#x2FF1 #x2FF9 #x2FF6 #x2FFB))
  74                 (memq (encode-char chr '=ucs-itaiji-002)
  75                       '(#x2FF1))
  76                 )
  77             (cons chr
  78                   (substring string 1))))))
  79
  80 (defun ids-parse-op-3 (string)
  81   (if (>= (length string) 1)
  82       (let ((chr (aref string 0)))
  83         (if (memq chr '(?\u2FF2 ?\u2FF3))
  84             (cons chr
  85                   (substring string 1))))))
  86
  87 (defun ids-parse-component (string simplify)
  88   (let ((ret (ids-parse-element string simplify))
  89         rret)
  90     (when ret
  91       (if (and simplify
  92                (listp (car ret))
  93                (setq rret (ideographic-structure-find-char
  94                            (cdr (assq 'ideographic-structure (car ret))))))
  95           (cons rret (cdr ret))
  96         ret))))
  97
  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))
 102            (setq op (car ret))
 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))
 108                      (cdr ret)))))
 109           ((setq ret (ids-parse-op-3 string))
 110            (setq op (car ret))
 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))
 118                        (cdr ret)))))))))
 119
 120 ;;;###autoload
 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)
 125         (car ret))))
 126
 127 ;; (defun ids-format-unit (ids-char)
 128 ;;   (let (ret)
 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))))))
 137
 138 ;; ;;;###autoload
 139 ;; (defun ids-format-list (ids-list)
 140 ;;   "Format ideographic-structure IDS-LIST as an IDS-string."
 141 ;;   (mapconcat (lambda (cell)
 142 ;;                (ids-format-unit
 143 ;;                 (if (char-ref-p cell)
 144 ;;                     (plist-get cell :char)
 145 ;;                   cell)))
 146 ;;              ids-list ""))
 147
 148 (define-obsolete-function-alias
 149   'ids-format-list 'ideographic-structure-to-ids)
 150
 151 ;;; @ End.
 152 ;;;
 153
 154 (provide 'ids)
 155
 156 ;;; ids.el ends here