iddef.el

   1 ;;; iddef.el --- Parser and utility for IDDef format files.
   2
   3 ;; Copyright (C) 2001 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
   6 ;; Keywords: IDDef, IDS, IDC, Ideographs, UCS, Unicode
   7
   8 ;; This file is a part of Tomoyo-Tools.
   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 ;; IDDef is a tab-separated format to describe some
  28 ;; character-attributes of each Ideographs mainly for Ideographic
  29 ;; structure.
  30
  31 ;;; Code:
  32
  33 (require 'ids)
  34 (require 'ids-util)
  35
  36 ;;;###autoload
  37 (defun iddef-read-buffer (buffer)
  38   (with-current-buffer buffer
  39     (goto-char (point-min))
  40     (let (ucs
  41           radical seq ret
  42           char struct
  43           morohashi m-chr)
  44       (while (re-search-forward
  45               "^U\\+\\([0-9A-F]+\\)\t\\([0-9]+\\)\t[^\t]+\t\\([^\t\n]+\\)"
  46               nil t)
  47         (setq ucs (string-to-int (match-string 1) 16)
  48               radical (string-to-int (match-string 2))
  49               seq (match-string 3))
  50         (setq ret (ids-parse-string seq))
  51         (when (and (consp ret)
  52                    (consp
  53                     (setq struct (cdr (assq 'ideographic-structure ret)))))
  54           (setq char (decode-char 'ucs ucs))
  55           (unless (get-char-attribute char 'ideograph-daikanwa)
  56             (when (and (setq morohashi
  57                              (get-char-attribute char 'morohashi-daikanwa))
  58                        (>= (length morohashi) 3))
  59               (setq m-chr
  60                     (if (= (nth 1 morohashi) 0)
  61                         (decode-char 'ideograph-daikanwa
  62                                      (setq morohashi (car morohashi)))
  63                       (setq morohashi (list (car morohashi)
  64                                             (nth 1 morohashi)))
  65                       (map-char-attribute (lambda (char val)
  66                                             (if (equal morohashi val)
  67                                                 char))
  68                                           'morohashi-daikanwa)))
  69               (unless (get-char-attribute m-chr 'ucs)
  70                 (put-char-attribute
  71                  m-chr
  72                  'ideographic-structure
  73                  (ideographic-structure-convert-to-daikanwa struct)))))
  74           (put-char-attribute char 'ideographic-structure struct)
  75           (dolist (ref (union
  76                         (get-char-attribute char '->same-ideograph)
  77                         (get-char-attribute char '->identical)))
  78             (if (setq ret
  79                       (cond ((characterp ref) ref)
  80                             ((char-ref-p ref)
  81                              (find-char (plist-get ref :char)))
  82                             (t
  83                              (find-char ref))))
  84                 (put-char-attribute ret 'ideographic-structure struct)))
  85           )))))
  86
  87 ;;;###autoload
  88 (defun iddef-read-file (file)
  89   (interactive "fIDDef file : ")
  90   (with-temp-buffer
  91     (let ((coding-system-for-read 'utf-8))
  92       (insert-file-contents file))
  93     (iddef-read-buffer (current-buffer))))
  94
  95
  96 ;;; @ End.
  97 ;;;
  98
  99 (provide 'iddef)
 100
 101 ;;; iddef.el ends here