idc.el

   1 (defun idc-parse-terminal (string)
   2   (if (>= (length string) 1)
   3       (let* ((chr (aref string 0))
   4              (ucs (get-char-attribute chr 'ucs))
   5              big5)
   6         (unless (and ucs (<= #x2FF0 ucs)(<= ucs #x2FFF))
   7           (if (and ucs (<= #xE000 ucs)(<= ucs #xF8FF)
   8                    (setq big5 (get-char-attribute chr 'chinese-big5)))
   9               (setq chr (decode-char 'chinese-big5-cdp big5)))
  10           (cons chr
  11                 (substring string 1))))))
  12
  13 (defun idc-parse-op-2 (string)
  14   (if (>= (length string) 1)
  15       (let* ((chr (aref string 0))
  16              (ucs (get-char-attribute chr 'ucs)))
  17         (if (or (eq ucs #x2FF0)
  18                 (eq ucs #x2FF1)
  19                 (and (<= #x2FF4 ucs)(<= ucs #x2FFB)))
  20             (cons chr
  21                   (substring string 1))))))
  22
  23 (defun idc-parse-op-3 (string)
  24   (if (>= (length string) 1)
  25       (let ((chr (aref string 0)))
  26         (if (memq chr '(?\u2FF2 ?\u2FF3))
  27             (cons chr
  28                   (substring string 1))))))
  29
  30 (defun idc-parse-component (string)
  31   (let ((ret (idc-parse-element string))
  32         rret)
  33     (when ret
  34       (if (and (listp (car ret))
  35                (setq rret (ideographic-structure-find-char
  36                            (cdr (assq 'ideographic-structure (car ret))))))
  37           (cons rret (cdr ret))
  38         ret))))
  39
  40 (defun idc-parse-element (string)
  41   (let (ret op arg1 arg2 arg3)
  42     (cond ((idc-parse-terminal string))
  43           ((setq ret (idc-parse-op-2 string))
  44            (setq op (car ret))
  45            (when (setq ret (idc-parse-component (cdr ret)))
  46              (setq arg1 (car ret))
  47              (when (setq ret (idc-parse-component (cdr ret)))
  48                (setq arg2 (car ret))
  49                (cons (list (list 'ideographic-structure op arg1 arg2))
  50                      (cdr ret)))))
  51           ((setq ret (idc-parse-op-3 string))
  52            (setq op (car ret))
  53            (when (setq ret (idc-parse-component (cdr ret)))
  54              (setq arg1 (car ret))
  55              (when (setq ret (idc-parse-component (cdr ret)))
  56                (setq arg2 (car ret))
  57                (when (setq ret (idc-parse-component (cdr ret)))
  58                  (setq arg3 (car ret))
  59                  (cons (list (list 'ideographic-structure op arg1 arg2 arg3))
  60                        (cdr ret)))))))))
  61
  62 (defun idc-parse-string (string)
  63   (let ((ret (idc-parse-element string)))
  64     (if (= (length (cdr ret)) 0)
  65         (car ret))))
  66
  67
  68 (require 'idc-util)
  69
  70 (defun idc-read-buffer (buffer)
  71   (with-current-buffer buffer
  72     (goto-char (point-min))
  73     (let (ucs
  74           radical seq ret
  75           char struct
  76           morohashi m-chr)
  77       (while (re-search-forward
  78               "^U\\+\\([0-9A-F]+\\)\t\\([0-9]+\\)\t[^\t]+\t\\([^\t\n]+\\)"
  79               nil t)
  80         (setq ucs (string-to-int (match-string 1) 16)
  81               radical (string-to-int (match-string 2))
  82               seq (match-string 3))
  83         (setq ret (idc-parse-string seq))
  84         (when (and (consp ret)
  85                    (consp
  86                     (setq struct (cdr (assq 'ideographic-structure ret)))))
  87           (setq char (decode-char 'ucs ucs))
  88           (unless (get-char-attribute char 'ideograph-daikanwa)
  89             (when (and (setq morohashi
  90                              (get-char-attribute char 'morohashi-daikanwa))
  91                        (>= (length morohashi) 3))
  92               (setq m-chr
  93                     (if (= (nth 1 morohashi) 0)
  94                         (decode-char 'ideograph-daikanwa
  95                                      (setq morohashi (car morohashi)))
  96                       (setq morohashi (list (car morohashi)
  97                                             (nth 1 morohashi)))
  98                       (map-char-attribute (lambda (char val)
  99                                             (if (equal morohashi val)
 100                                                 char))
 101                                           'morohashi-daikanwa)))
 102               (put-char-attribute
 103                m-chr
 104                'ideographic-structure
 105                (ideographic-structure-convert-to-daikanwa struct))))
 106           (put-char-attribute char 'ideographic-structure struct)
 107           (dolist (ref (union
 108                         (get-char-attribute char '->same-ideograph)
 109                         (get-char-attribute char '->identical)))
 110             (if (setq ret
 111                       (cond ((characterp ref) ref)
 112                             ((char-ref-p ref)
 113                              (find-char (plist-get ref :char)))
 114                             (t
 115                              (find-char ref))))
 116                 (put-char-attribute ret 'ideographic-structure struct)))
 117           )))))
 118
 119 ;; (idc-read-buffer "IDDef1.txt")