;;; Code:
(setq tomoyo-modules-to-compile
- '(csv ids ids-util iddef))
+ '(csv))
(setq tomoyo-modules-not-to-compile nil)
+++ /dev/null
-;;; iddef.el --- Parser and utility for IDDef format files.
-
-;; Copyright (C) 2001,2002 MORIOKA Tomohiko
-
-;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
-;; Keywords: IDDef, IDS, IDC, Ideographs, UCS, Unicode
-
-;; This file is a part of Tomoyo-Tools.
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; IDDef is a tab-separated format to describe some
-;; character-attributes of each Ideographs mainly for Ideographic
-;; structure.
-
-;;; Code:
-
-(require 'ids)
-(require 'ids-util)
-
-;;;###autoload
-(defun iddef-read-buffer (buffer &optional ucs-only)
- (with-current-buffer buffer
- (goto-char (point-min))
- (let (ucs
- radical seq ret
- char struct
- morohashi m-chr)
- (while (re-search-forward
- "^U\\+\\([0-9A-F]+\\)\t\\([0-9]+\\)\t[^\t]+\t\\([^\t\n]+\\)"
- nil t)
- (setq ucs (string-to-int (match-string 1) 16)
- radical (string-to-int (match-string 2))
- seq (match-string 3))
- (setq ret (ids-parse-string seq))
- (when (and (consp ret)
- (consp
- (setq struct (cdr (assq 'ideographic-structure ret)))))
- (setq char (decode-char 'ucs ucs))
- (unless (or ucs-only (get-char-attribute char 'ideograph-daikanwa))
- (when (and (setq morohashi
- (get-char-attribute char 'morohashi-daikanwa))
- (>= (length morohashi) 3))
- (setq m-chr
- (if (= (nth 1 morohashi) 0)
- (decode-char 'ideograph-daikanwa
- (setq morohashi (car morohashi)))
- (setq morohashi (list (car morohashi)
- (nth 1 morohashi)))
- (map-char-attribute (lambda (char val)
- (if (equal morohashi val)
- char))
- 'morohashi-daikanwa)))
- (when m-chr
- (unless (get-char-attribute m-chr 'ucs)
- (put-char-attribute
- m-chr
- 'ideographic-structure
- (ideographic-structure-convert-to-daikanwa struct))))))
- (put-char-attribute char 'ideographic-structure struct)
- (dolist (ref (union
- (get-char-attribute char '->same-ideograph)
- (get-char-attribute char '->identical)))
- (if (setq ret
- (cond ((characterp ref) ref)
- ((char-ref-p ref)
- (find-char (plist-get ref :char)))
- (t
- (find-char ref))))
- (unless (get-char-attribute ret 'ucs)
- (put-char-attribute ret 'ideographic-structure struct))))
- )))))
-
-;;;###autoload
-(defun iddef-read-file (file &optional ucs-only)
- (interactive "fIDDef file : \nP")
- (with-temp-buffer
- (let ((coding-system-for-read 'utf-8))
- (insert-file-contents file))
- (iddef-read-buffer (current-buffer) ucs-only)))
-
-;;;###autoload
-(defun iddef-check-mapping-buffer (buffer)
- (with-current-buffer buffer
- (goto-char (point-min))
- (let (ucs radical hyd plane code ccs chr ret hyd-v hyd-p hyd-c)
- (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)
- (setq ucs (string-to-int (match-string 1) 16)
- radical (string-to-int (match-string 2))
- hyd (match-string 3)
- plane (string-to-int (match-string 4) 16)
- code (string-to-int (match-string 5) 16))
- (setq ccs
- (if (= plane 0)
- (progn
- (setq chr (decode-char 'chinese-big5 code))
- (if (and (setq ret (get-char-attribute chr 'ucs))
- (<= #xE000 ret)(<= ret #xF848))
- 'chinese-big5-cdp))
- (intern (format "ideograph-hanziku-%d" plane))))
- (when ccs
- (setq chr (decode-char ccs code))
- (if (setq ret (or (get-char-attribute chr 'ucs)
- (get-char-attribute chr '=>ucs)
- (get-char-attribute chr '->ucs)))
- (unless (= ret ucs)
- (put-char-attribute chr 'ucs-cdp ucs))
- (if (eq (get-char-attribute chr ccs) code)
- (put-char-attribute chr 'ucs ucs)
- (setq chr (define-char (list (cons 'ucs ucs)
- (cons ccs code)))))
- )
- (when (and hyd
- (string-match "^\\([1-9]\\)\\([0-9][0-9][0-9][0-9]\\)\\.\\([0-9][0-9]\\)0$"
- hyd))
- (setq hyd-v (string-to-int (match-string 1 hyd))
- hyd-p (string-to-int (match-string 2 hyd))
- hyd-c (string-to-int (match-string 3 hyd)))
- (put-char-attribute chr 'hanyu-dazidian
- (list hyd-v hyd-p hyd-c))
- (remove-char-attribute chr 'hanyu-dazidian-vol)
- (remove-char-attribute chr 'hanyu-dazidian-page)
- (remove-char-attribute chr 'hanyu-dazidian-char)
- )
- (unless (get-char-attribute chr 'ideographic-radical)
- (put-char-attribute chr 'ideographic-radical radical))
- )))))
-
-;;;###autoload
-(defun iddef-check-mapping-file (file)
- (interactive "fIDDef file : ")
- (with-temp-buffer
- (let ((coding-system-for-read 'utf-8))
- (insert-file-contents file))
- (iddef-check-mapping-buffer (current-buffer))))
-
-
-;;; @ End.
-;;;
-
-(provide 'iddef)
-
-;;; iddef.el ends here
+++ /dev/null
-;;; ids-util.el --- Utilities about ideographic-structure -*- coding: utf-8 -*-
-
-;; Copyright (C) 2001,2002 MORIOKA Tomohiko
-
-;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
-;; Keywords: ideographic-structure, UTF-2000, database
-
-;; This file is a part of Tomoyo Utilities.
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-;;;###autoload
-(defun ideographic-structure-convert-to-ucs (structure)
- (let (dest cell ucs ret)
- (while structure
- (setq cell (car structure))
- (setq dest
- (cons
- (cond ((characterp cell)
- (if (or (get-char-attribute cell 'ucs)
- (null
- (setq ucs
- (or (get-char-attribute cell '=>ucs)
- (get-char-attribute cell '->ucs)))))
- cell
- (decode-char 'ucs ucs)))
- ((and (consp cell)
- (symbolp (car cell)))
- cell)
- ((setq ret (find-char cell))
- (if (or (get-char-attribute ret 'ucs)
- (null
- (setq ucs
- (or (get-char-attribute ret '=>ucs)
- (get-char-attribute ret '->ucs)))))
- cell
- (decode-char 'ucs ucs)))
- ((setq ret (assq 'ideographic-structure cell))
- (put-alist 'ideographic-structure
- (ideographic-structure-convert-to-ucs
- (cdr ret))
- (copy-alist cell)))
- (t cell))
- dest))
- (setq structure (cdr structure)))
- (nreverse dest)))
-
-(defvar morohashi-char-replace-alist
- (list
- (cons (decode-char 'chinese-big5-cdp #x8B42)
- (decode-char 'chinese-big5-cdp #x8B42))
- (cons (decode-char 'chinese-big5-cdp #x8AFC)
- (decode-char 'chinese-big5-cdp #x8AFC))
- (cons (decode-char 'ucs #x2EBE)
- (decode-char 'ucs #x2EBF))
- (cons (decode-char 'ucs #x4EA0)
- (decode-char 'chinese-big5-cdp #x8B42))
- (cons (decode-char 'ucs #x4EBD)
- (decode-char 'chinese-big5-cdp #x8AFC))
- (cons (decode-char 'ucs #x517C)
- (decode-char 'ideograph-gt 01936))
- (cons ?亼 (decode-char 'chinese-big5-cdp #x8AFC))
- (cons (decode-char 'chinese-big5-cdp #x8AFC)
- (decode-char 'chinese-big5-cdp #x8AFC))
- (cons (decode-char 'chinese-big5-cdp #x8B69)
- (decode-char 'chinese-big5-cdp #x8A60))
- (cons (decode-char 'ucs #x4FDE)
- (decode-char 'ideograph-daikanwa 01437))
- (cons (decode-char 'ucs #x5151)
- (decode-char 'ideograph-daikanwa 01356))
- (cons (decode-char 'ucs #x5154)
- (decode-char 'ideograph-daikanwa 01368))
- (cons (decode-char 'ucs #x5179)
- (decode-char 'ideograph-daikanwa 30911))
- (cons (decode-char 'ucs #x518D)
- (decode-char 'ideograph-daikanwa 01524))
- (cons (decode-char 'ucs #x5193)
- (decode-char 'ideograph-gt 02025))
- (cons (decode-char 'ucs #x53CA)
- (decode-char 'ideograph-daikanwa 03118))
- (cons (decode-char 'ucs #x544A)
- (decode-char 'ideograph-daikanwa 03381))
- (cons (decode-char 'ucs #x5468)
- (decode-char 'ideograph-daikanwa 03441))
- '(?夂 . ?夂)
- (cons (decode-char 'ucs #x5922)
- (decode-char 'ideograph-daikanwa 05802))
- (cons (decode-char 'ucs #x5C1A)
- (decode-char 'ucs #x5C19))
- (cons (decode-char 'ucs #x5D29)
- (decode-char 'ideograph-daikanwa 08212))
- (cons (decode-char 'ucs #x5F66)
- (decode-char 'ideograph-daikanwa 09980))
- (cons (decode-char 'ucs #x6247)
- (decode-char 'ideograph-daikanwa 11743))
- (cons (decode-char 'ucs #x656C)
- (decode-char 'ideograph-daikanwa 13303))
- (cons (decode-char 'ucs #x65E2)
- (decode-char 'ideograph-daikanwa 13724))
- (cons (decode-char 'ucs #x6B21)
- (decode-char 'ideograph-daikanwa 15992))
- (cons (decode-char 'ucs #x7235)
- (decode-char 'ideograph-daikanwa 19711))
- (cons (decode-char 'ucs #x7523)
- (decode-char 'ideograph-daikanwa 21684))
- (cons (decode-char 'ucs #x76CA)
- (decode-char 'ideograph-daikanwa 22972))
- (cons (decode-char 'ucs #x771F)
- (decode-char 'ideograph-daikanwa 23235))
- (cons (decode-char 'ucs #x7FBD)
- (decode-char 'ideograph-daikanwa 28614))
- (cons (decode-char 'ucs #x7FC1)
- (decode-char 'ideograph-daikanwa 28635))
- (cons (decode-char 'ucs #x2EA4)
- (decode-char 'ucs #x722B))
- (cons (decode-char 'ucs #x8005)
- (decode-char 'ideograph-daikanwa 28853))
- (cons (decode-char 'ucs #x8096)
- (decode-char 'ideograph-daikanwa 29263))
- (cons (decode-char 'ucs #x82E5)
- (decode-char 'ideograph-daikanwa 30796))
- (cons (decode-char 'ucs #x82D7)
- (decode-char 'ideograph-daikanwa 30781))
- (cons (decode-char 'ucs #x82F1)
- (decode-char 'ideograph-daikanwa 30808))
- (cons (decode-char 'ucs #x8336)
- (decode-char 'ideograph-daikanwa 30915))
- (cons (decode-char 'ucs #x8449)
- (decode-char 'ideograph-daikanwa 31387))
- (cons (decode-char 'ucs #x9023)
- (decode-char 'ideograph-daikanwa 38902))
- (cons (decode-char 'ucs #x9053)
- (decode-char 'ideograph-daikanwa 39010))
- (cons (decode-char 'ucs #x9054)
- (decode-char 'ideograph-daikanwa 39011))
- (cons (decode-char 'ucs #x9063)
- (decode-char 'ideograph-daikanwa 39052))
- (cons (decode-char 'ucs #x9752)
- (decode-char 'ucs #x9751))
- (cons (decode-char 'ucs #x670B)
- (decode-char 'ideograph-daikanwa 14340))
- (cons (decode-char 'ucs #x8981)
- (decode-char 'ideograph-daikanwa 34768))
- (cons (decode-char 'ucs #x8AF8)
- (decode-char 'ideograph-daikanwa 35743))
- (cons (decode-char 'japanese-jisx0213-2 #x2327)
- (decode-char 'japanese-jisx0213-2 #x2327))
- (cons (decode-char 'chinese-big5-cdp #x8BFA)
- (decode-char 'japanese-jisx0213-2 #x2327))
- ))
-
-;;;###autoload
-(defun ideographic-structure-convert-to-daikanwa (structure)
- (let (dest cell morohashi ret ret2 ret3)
- (while structure
- (setq cell (car structure))
- (setq dest
- (cons
- (cond ((characterp cell)
- (cond ((setq ret
- (assq cell morohashi-char-replace-alist))
- (cdr ret))
- ((get-char-attribute cell 'ideograph-daikanwa)
- cell)
- ((setq morohashi
- (get-char-attribute
- cell 'morohashi-daikanwa))
- (cond ((null (cdr (cdr morohashi)))
- cell)
- ((= (nth 1 morohashi) 0)
- (decode-char 'ideograph-daikanwa
- (car morohashi)))
- (t
- (setq morohashi (list (car morohashi)
- (nth 1 morohashi)))
- (or (map-char-attribute
- (lambda (char val)
- (if (equal morohashi val)
- char))
- 'morohashi-daikanwa)
- cell))))
- (t
- cell)))
- ((and (consp cell)
- (symbolp (car cell)))
- cell)
- ((setq ret (find-char cell))
- (if (or (get-char-attribute ret 'ideograph-daikanwa)
- (null
- (setq morohashi
- (get-char-attribute
- ret 'morohashi-daikanwa)))
- (null (cdr (cdr morohashi))))
- cell
- (if (= (nth 1 morohashi) 0)
- (decode-char 'ideograph-daikanwa (car morohashi))
- cell)))
- ((setq ret (assq 'ideographic-structure cell))
- (setq ret2
- (ideographic-structure-convert-to-daikanwa
- (cdr ret)))
- (if (setq ret3 (ideographic-structure-find-char ret2))
- ret3
- (put-alist 'ideographic-structure
- ret2
- (copy-alist cell))))
- (t cell))
- dest))
- (setq structure (cdr structure)))
- (nreverse dest)))
-
-
-;;; @ End.
-;;;
-
-(provide 'ids-util)
-
-;;; ids-util.el ends here
+++ /dev/null
-;;; ids.el --- Parser and utility for Ideographic Description Sequence.
-
-;; Copyright (C) 2001,2002 MORIOKA Tomohiko
-
-;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
-;; Keywords: IDS, IDC, Ideographs, UCS, Unicode
-
-;; This file is a part of Tomoyo-Tools.
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Ideographic Description Sequence (IDS) is defined in ISO/IEC
-;; 10646-1:2000 Annex F.
-
-;;; Code:
-
-(defun ids-parse-terminal (string)
- (if (>= (length string) 1)
- (let* ((chr (aref string 0))
- (ucs (get-char-attribute chr 'ucs))
- big5)
- (unless (and ucs (<= #x2FF0 ucs)(<= ucs #x2FFF))
- (if (and ucs (<= #xE000 ucs)(<= ucs #xF8FF)
- (setq big5 (get-char-attribute chr 'chinese-big5)))
- (setq chr (decode-char 'chinese-big5-cdp big5)))
- (cons chr
- (substring string 1))))))
-
-(defun ids-parse-op-2 (string)
- (if (>= (length string) 1)
- (let* ((chr (aref string 0))
- (ucs (get-char-attribute chr 'ucs)))
- (if (or (eq ucs #x2FF0)
- (eq ucs #x2FF1)
- (and (<= #x2FF4 ucs)(<= ucs #x2FFB)))
- (cons chr
- (substring string 1))))))
-
-(defun ids-parse-op-3 (string)
- (if (>= (length string) 1)
- (let ((chr (aref string 0)))
- (if (memq chr '(?\u2FF2 ?\u2FF3))
- (cons chr
- (substring string 1))))))
-
-(defun ids-parse-component (string)
- (let ((ret (ids-parse-element string))
- rret)
- (when ret
- (if (and (listp (car ret))
- (setq rret (ideographic-structure-find-char
- (cdr (assq 'ideographic-structure (car ret))))))
- (cons rret (cdr ret))
- ret))))
-
-(defun ids-parse-element (string)
- (let (ret op arg1 arg2 arg3)
- (cond ((ids-parse-terminal string))
- ((setq ret (ids-parse-op-2 string))
- (setq op (car ret))
- (when (setq ret (ids-parse-component (cdr ret)))
- (setq arg1 (car ret))
- (when (setq ret (ids-parse-component (cdr ret)))
- (setq arg2 (car ret))
- (cons (list (list 'ideographic-structure op arg1 arg2))
- (cdr ret)))))
- ((setq ret (ids-parse-op-3 string))
- (setq op (car ret))
- (when (setq ret (ids-parse-component (cdr ret)))
- (setq arg1 (car ret))
- (when (setq ret (ids-parse-component (cdr ret)))
- (setq arg2 (car ret))
- (when (setq ret (ids-parse-component (cdr ret)))
- (setq arg3 (car ret))
- (cons (list (list 'ideographic-structure op arg1 arg2 arg3))
- (cdr ret)))))))))
-
-;;;###autoload
-(defun ids-parse-string (ids-string)
- "Parse IDS-STRING and return the result."
- (let ((ret (ids-parse-element ids-string)))
- (if (= (length (cdr ret)) 0)
- (car ret))))
-
-(defun ids-format-unit (ids-char)
- (let (ret)
- (cond ((characterp ids-char)
- (char-to-string ids-char))
- ((integerp ids-char)
- (char-to-string (decode-char 'ucs ids-char)))
- ((setq ret (find-char ids-char))
- (char-to-string ret))
- ((setq ret (assq 'ideographic-structure ids-char))
- (ids-format-list (cdr ret))))))
-
-;;;###autoload
-(defun ids-format-list (ids-list)
- "Format ideographic-structure IDS-LIST as an IDS-string."
- (mapconcat (lambda (cell)
- (ids-format-unit
- (if (char-ref-p cell)
- (plist-get cell :char)
- cell)))
- ids-list ""))
-
-
-;;; @ End.
-;;;
-
-(provide 'ids)
-
-;;; ids.el ends here
projects / chise / tomoyo-tools.git / commitdiff