From: tomo Date: Wed, 17 Apr 2002 10:18:16 +0000 (+0000) Subject: Move ids.el, ids-util.el and iddef.el to the IDS package. X-Git-Tag: chise-base-0_23~79 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=7c2f953a897138efed19b54939aa5cacd08a259c;p=chise%2Ftomoyo-tools.git Move ids.el, ids-util.el and iddef.el to the IDS package. --- diff --git a/TOMOYO-ELS b/TOMOYO-ELS index c2fd639..eb1c040 100644 --- a/TOMOYO-ELS +++ b/TOMOYO-ELS @@ -5,7 +5,7 @@ ;;; Code: (setq tomoyo-modules-to-compile - '(csv ids ids-util iddef)) + '(csv)) (setq tomoyo-modules-not-to-compile nil) diff --git a/iddef.el b/iddef.el deleted file mode 100644 index 11dbe58..0000000 --- a/iddef.el +++ /dev/null @@ -1,158 +0,0 @@ -;;; iddef.el --- Parser and utility for IDDef format files. - -;; Copyright (C) 2001,2002 MORIOKA Tomohiko - -;; Author: MORIOKA Tomohiko -;; 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 diff --git a/ids-util.el b/ids-util.el deleted file mode 100644 index 5892ac3..0000000 --- a/ids-util.el +++ /dev/null @@ -1,235 +0,0 @@ -;;; ids-util.el --- Utilities about ideographic-structure -*- coding: utf-8 -*- - -;; Copyright (C) 2001,2002 MORIOKA Tomohiko - -;; Author: MORIOKA Tomohiko -;; 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 diff --git a/ids.el b/ids.el deleted file mode 100644 index a8a4182..0000000 --- a/ids.el +++ /dev/null @@ -1,127 +0,0 @@ -;;; ids.el --- Parser and utility for Ideographic Description Sequence. - -;; Copyright (C) 2001,2002 MORIOKA Tomohiko - -;; Author: MORIOKA Tomohiko -;; 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