iddef.el

   1 ;;; iddef.el --- Parser and utility for IDDef format files.
   2
   3 ;; Copyright (C) 2001,2002 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 &optional ucs-only)
  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 (or ucs-only (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               (when m-chr
  70                 (unless (get-char-attribute m-chr 'ucs)
  71                   (put-char-attribute
  72                    m-chr
  73                    'ideographic-structure
  74                    (ideographic-structure-convert-to-daikanwa struct))))))
  75           (put-char-attribute char 'ideographic-structure struct)
  76           (dolist (ref (union
  77                         (get-char-attribute char '->same-ideograph)
  78                         (get-char-attribute char '->identical)))
  79             (if (setq ret
  80                       (cond ((characterp ref) ref)
  81                             ((char-ref-p ref)
  82                              (find-char (plist-get ref :char)))
  83                             (t
  84                              (find-char ref))))
  85                 (unless (get-char-attribute ret 'ucs)
  86                   (put-char-attribute ret 'ideographic-structure struct))))
  87           )))))
  88
  89 ;;;###autoload
  90 (defun iddef-read-file (file &optional ucs-only)
  91   (interactive "fIDDef file : \nP")
  92   (with-temp-buffer
  93     (let ((coding-system-for-read 'utf-8))
  94       (insert-file-contents file))
  95     (iddef-read-buffer (current-buffer) ucs-only)))
  96
  97 ;;;###autoload
  98 (defun iddef-check-mapping-buffer (buffer)
  99   (with-current-buffer buffer
 100     (goto-char (point-min))
 101     (let (ucs radical hyd plane code ccs chr ret hyd-v hyd-p hyd-c)
 102       (while (re-search-forward "^U\\+\\([0-9A-F]+\\)\t\\([0-9]+\\)\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t\\([0-9A-C]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\)" nil t)
 103         (setq ucs (string-to-int (match-string 1) 16)
 104               radical (string-to-int (match-string 2))
 105               hyd (match-string 3)
 106               plane (string-to-int (match-string 4) 16)
 107               code (string-to-int (match-string 5) 16))
 108         (setq ccs
 109               (if (= plane 0)
 110                   (progn
 111                     (setq chr (decode-char 'chinese-big5 code))
 112                     (if (and (setq ret (get-char-attribute chr 'ucs))
 113                              (<= #xE000 ret)(<= ret #xF848))
 114                         'chinese-big5-cdp))
 115                 (intern (format "ideograph-hanziku-%d" plane))))
 116         (when ccs
 117           (setq chr (decode-char ccs code))
 118           (if (setq ret (or (get-char-attribute chr 'ucs)
 119                             (get-char-attribute chr '=>ucs)
 120                             (get-char-attribute chr '->ucs)))
 121               (unless (= ret ucs)
 122                 (put-char-attribute chr 'ucs-cdp ucs))
 123             (if (eq (get-char-attribute chr ccs) code)
 124                 (put-char-attribute chr 'ucs ucs)
 125               (setq chr (define-char (list (cons 'ucs ucs)
 126                                            (cons ccs code)))))
 127             )
 128           (when (and hyd
 129                      (string-match "^\\([1-9]\\)\\([0-9][0-9][0-9][0-9]\\)\\.\\([0-9][0-9]\\)0$"
 130                                    hyd))
 131             (setq hyd-v (string-to-int (match-string 1 hyd))
 132                   hyd-p (string-to-int (match-string 2 hyd))
 133                   hyd-c (string-to-int (match-string 3 hyd)))
 134             (put-char-attribute chr 'hanyu-dazidian
 135                                 (list hyd-v hyd-p hyd-c))
 136             (remove-char-attribute chr 'hanyu-dazidian-vol)
 137             (remove-char-attribute chr 'hanyu-dazidian-page)
 138             (remove-char-attribute chr 'hanyu-dazidian-char)
 139             )
 140           (unless (get-char-attribute chr 'ideographic-radical)
 141             (put-char-attribute chr 'ideographic-radical radical))
 142           )))))
 143
 144 ;;;###autoload
 145 (defun iddef-check-mapping-file (file)
 146   (interactive "fIDDef file : ")
 147   (with-temp-buffer
 148     (let ((coding-system-for-read 'utf-8))
 149       (insert-file-contents file))
 150     (iddef-check-mapping-buffer (current-buffer))))
 151
 152
 153 ;;; @ End.
 154 ;;;
 155
 156 (provide 'iddef)
 157
 158 ;;; iddef.el ends here