(ids-read-buffer): Add new optional argument `simplify'; if `simplify'

[chise/ids.git] / ids.el

diff --git a/ids.el b/ids.el
index da4101e..1ae8464 100644 (file)
--- a/ids.el
+++ b/ids.el
@@ -1,6 +1,6 @@
 ;;; ids.el --- Parser and utility for Ideographic Description Sequence.
 
-;; Copyright (C) 2001 MORIOKA Tomohiko
+;; Copyright (C) 2001,2002 MORIOKA Tomohiko
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: IDS, IDC, Ideographs, UCS, Unicode
@@ -58,44 +58,67 @@
            (cons chr
                  (substring string 1))))))
 
-(defun ids-parse-component (string)
-  (let ((ret (ids-parse-element string))
+(defun ids-parse-component (string simplify)
+  (let ((ret (ids-parse-element string simplify))
        rret)
     (when ret
-      (if (and (listp (car ret))
+      (if (and simplify
+              (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)
+(defun ids-parse-element (string simplify)
   (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)))
+          (when (setq ret (ids-parse-component (cdr ret) simplify))
             (setq arg1 (car ret))
-            (when (setq ret (ids-parse-component (cdr ret)))
+            (when (setq ret (ids-parse-component (cdr ret) simplify))
               (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)))
+          (when (setq ret (ids-parse-component (cdr ret) simplify))
             (setq arg1 (car ret))
-            (when (setq ret (ids-parse-component (cdr ret)))
+            (when (setq ret (ids-parse-component (cdr ret) simplify))
               (setq arg2 (car ret))
-              (when (setq ret (ids-parse-component (cdr ret)))
+              (when (setq ret (ids-parse-component (cdr ret) simplify))
                 (setq arg3 (car ret))
                 (cons (list (list 'ideographic-structure op arg1 arg2 arg3))
                       (cdr ret)))))))))
 
 ;;;###autoload
-(defun ids-parse-string (string)
-  (let ((ret (ids-parse-element string)))
+(defun ids-parse-string (ids-string &optional simplify)
+  "Parse IDS-STRING and return the result."
+  (let ((ret (ids-parse-element ids-string simplify)))
     (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.
 ;;;