(concord-kanbun-add-word-class): New implementation.

(concord-kanbun-read-sentence): Don't add word-class information to
name of sentence.

diff --git a/concord-kanbun-dic.el b/concord-kanbun-dic.el
index 6131b0f..ea26063 100644 (file)
--- a/concord-kanbun-dic.el
+++ b/concord-kanbun-dic.el
@@ -71,40 +71,35 @@
 
 ;; (save-char-attribute-table '*instance@morpheme-entry/zh-classical)
 
-(defun concord-kanbun-add-word-class (word-superclass
-                                     word-class
-                                     word-subclass1 word-subclass2
-                                     word-subclass3)
-  (let (wc-name wc-cobj wc-name-id)
-    (when (and word-superclass
-              (not (string= word-superclass "*")))
-      (setq wc-name word-superclass)
-      (when (and word-class
-                (not (string= word-class "*")))
+(defun concord-kanbun-add-word-class (&rest word-class)
+  (let (wc-name wc-cobj wc-name-id parent-wc-cobj
+               r-wcl)
+    (dolist (wcf word-class)
+      (when (and wcf
+                (not (string= wcf "*")))
+       (setq r-wcl (cons wcf r-wcl))
        (setq wc-name
-             (format "%s,%s" wc-name word-class))
-       (when (and word-subclass1
-                  (not (string= word-subclass1 "*")))
-         (setq wc-name
-               (format "%s,%s" wc-name word-subclass1))
-         (when (and word-subclass2
-                    (not (string= word-subclass2 "*")))
-           (setq wc-name
-                 (format "%s,%s" wc-name word-subclass2))
-           (when (and word-subclass3
-                      (not (string= word-subclass3 "*")))
-             (setq wc-name
-                   (format "%s,%s" wc-name word-subclass3)))))))
+             (if wc-name
+                 (format "%s,%s" wc-name wcf)
+               wcf))))
+    (unless wc-name
+      (setq wc-name "*"))
     (unless (setq wc-cobj (concord-decode-object
                           '=name wc-name
                           'word-class@zh-classical))
       (setq wc-name-id (intern (concord-kanbun-encode-name-as-id wc-name)))
       (setq wc-cobj (concord-make-object
                     'word-class@zh-classical wc-name-id))
-      (concord-object-put wc-cobj '=name wc-name))
+      (concord-object-put wc-cobj '=name wc-name)
+      (when (and r-wcl
+                (setq parent-wc-cobj
+                      (apply #'concord-kanbun-add-word-class
+                             (nreverse (cdr r-wcl)))))
+       (concord-object-put
+        wc-cobj '<-subcategory (list parent-wc-cobj)))
+      )
     wc-cobj))
 
-
 (defun concord-kanbun-add-morpheme (entry word-superclass word-class
                                          word-subclass1 word-subclass2
                                          word-subclass3
@@ -185,7 +180,7 @@
        end send
        ret
        sentence dest
-       sentence-name
+        ;; sentence-name
        sentence-id-name sentence-id sentence-cobj
        sentence-entry-cobj)
     (prog1
@@ -198,14 +193,14 @@
              (setq ret (concord-kanbun-parse-corpus-line
                         (buffer-substring (point-at-bol)(point-at-eol))))
              (setq sentence (concat sentence (car ret)))
-             (setq sentence-name
-                   (concat sentence-name
-                           (if sentence-name
-                               " ")
-                           (format "%s[%s,%s,%s]"
-                                   (car ret)
-                                   (nth 2 ret)
-                                   (nth 3 ret)(nth 4 ret))))
+              ;; (setq sentence-name
+              ;;       (concat sentence-name
+              ;;               (if sentence-name
+              ;;                   " ")
+              ;;               (format "%s[%s,%s,%s]"
+              ;;                       (car ret)
+              ;;                       (nth 2 ret)
+              ;;                       (nth 3 ret)(nth 4 ret))))
              (setq dest
                    (cons (apply #'concord-kanbun-add-morpheme ret)
                          dest))
@@ -223,12 +218,12 @@
              (setq sentence-cobj
                    (concord-make-object
                     'sentence@zh-classical sentence-id))
-             (concord-object-put
-              sentence-cobj '=name (format "%s(%s)"
-                                           sentence-name sentence-id-name))
               ;; (concord-object-put
               ;;  sentence-cobj '=name (format "%s(%s)"
-              ;;                               sentence sentence-id-name))
+              ;;                               sentence-name sentence-id-name))
+             (concord-object-put
+              sentence-cobj '=name (format "%s(%s)"
+                                           sentence sentence-id-name))
              )
            (concord-object-put
             sentence-cobj 'source/file-name source-name)