From ddb1f04a08f7dd1e3c50a550e4cdde9a1c357a8c Mon Sep 17 00:00:00 2001
From: MORIOKA Tomohiko <tomo.git@chise.org>
Date: Sat, 21 Sep 2013 20:46:01 +0900
Subject: [PATCH] (concord-kanbun-add-word-class): New implementation.
 (concord-kanbun-read-sentence): Don't add word-class
 information to name of sentence.

---
 concord-kanbun-dic.el |   71 +++++++++++++++++++++++--------------------------
 1 file changed, 33 insertions(+), 38 deletions(-)

diff --git a/concord-kanbun-dic.el b/concord-kanbun-dic.el
index 6131b0f..ea26063 100644
--- 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)
-- 
1.7.10.4