1 ;;; ids-rw.el --- Rewriting utility for ideographic-structure.
3 ;; Copyright (C) 2006, 2020 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
6 ;; Keywords: IDS, TRS, IDC, Ideographs, UCS, Unicode
8 ;; This file is a part of IDS.
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.
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.
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.
29 (defun ideographic-structure-unify-char (structure pattern &optional env)
30 (if (char-ref-p structure)
31 (setq structure (plist-get structure :char)))
33 ((eq structure pattern)
39 (let ((ret (assq pattern env)))
41 (if (eq structure (cdr ret))
43 (cons (cons pattern structure)
46 (defun ideographic-structure-unify-unit (structure pattern &optional env)
47 (or (ideographic-structure-unify-char structure pattern env)
48 (let (prest srest ret)
53 (cdr (assq 'ideographic-structure structure))
54 (char-feature structure 'ideographic-structure)))
57 (setq srest structure)
60 (cond ((consp pattern)
61 (cdr (assq 'ideographic-structure pattern))
64 (char-feature pattern 'ideographic-structure)
71 (if (not (setq env (ideographic-structure-unify-unit
72 (car srest) (car prest) env)))
74 (setq prest (cdr prest)
79 (defun ideographic-structure-apply-to-term (term env)
83 (if (setq ret (assq term env))
87 (cond ((setq ret (assq 'ideographic-structure term))
95 (cons (ideographic-structure-apply-to-term
98 (setq rest (cdr rest)))
99 (list (cons 'ideographic-structure (nreverse dest)))
104 (defun ideographic-structure-rewrite (structure
107 (if (setq env (ideographic-structure-unify-unit structure pattern env))
108 (ideographic-structure-apply-to-term replacement env)
109 (let (srest cell ret dest)
111 (if (consp structure)
112 (cdr (assq 'ideographic-structure structure))
113 (char-feature structure 'ideographic-structure)))
114 (setq structure ret))
115 (when (consp structure)
116 (setq srest (cdr structure))
119 (if (setq ret (ideographic-structure-rewrite
124 (setq dest (cons (car srest) dest)
126 (cons (car structure)
127 (append (nreverse (cons ret dest))
131 (defun ideographic-structure-rewrite-by-rules (structure rules)
138 (setq rule (car rest))
139 (if (setq ret (ideographic-structure-rewrite structure
143 (setq rest (cdr rest))))
144 (if (equal ret structure)
146 (setq structure ret)))))
156 ;;; ids-rw.el ends here