X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=calist.el;h=504476ae05a94a4b6c6ec101de7db1e8cf21a941;hb=43e8d049b32bc665b19ce90920000f4f0aed47df;hp=0554737cb786a2b4e92c1f8b23b9243c2bc36ab1;hpb=8d071b170cc696db38cd36ed48adecc42e3aac55;p=elisp%2Fapel.git

diff --git a/calist.el b/calist.el
index 0554737..504476a 100644
--- a/calist.el
+++ b/calist.el
@@ -132,11 +132,17 @@ even if other rules are matched for ALIST."
 	    (let ((ret-alist (calist-field-match alist type (car choice))))
 	      (if ret-alist
 		  (if (cdr choice)
-		      (setq dest
-			    (append (ctree-find-calist
-				     (cdr choice) ret-alist all)
-				    dest))
-		    (setq dest (cons ret-alist dest))
+		      (let ((ret (ctree-find-calist
+				  (cdr choice) ret-alist all)))
+			(while ret
+			  (let ((elt (car ret)))
+			    (or (member elt dest)
+				(setq dest (cons elt dest))
+				))
+			  (setq ret (cdr ret))
+			  ))
+		    (or (member ret-alist dest)
+			(setq dest (cons ret-alist dest)))
 		    )))))
 	(setq choices (cdr choices)))
       (or (and (not all) dest)
@@ -144,11 +150,17 @@ even if other rules are matched for ALIST."
 	      (let ((ret-alist (calist-field-match alist type t)))
 		(if ret-alist
 		    (if (cdr default)
-			(setq dest
-			      (append (ctree-find-calist
-				       (cdr default) ret-alist all)
-				      dest))
-		      (setq dest (cons ret-alist dest))
+			(let ((ret (ctree-find-calist
+				    (cdr default) ret-alist all)))
+			  (while ret
+			    (let ((elt (car ret)))
+			      (or (member elt dest)
+				  (setq dest (cons elt dest))
+				  ))
+			    (setq ret (cdr ret))
+			    ))
+		      (or (member ret-alist dest)
+			  (setq dest (cons ret-alist dest)))
 		      ))))
 	  )
       dest)))
@@ -207,7 +219,7 @@ even if other rules are matched for ALIST."
 		(type (car cell))
 		(value (cdr cell)))
 	   (cons type
-		 (list '(t)
+		 (list (list t)
 		       (cons value (calist-to-ctree (cdr calist)))))
 	   ))
 	(t
@@ -226,12 +238,19 @@ even if other rules are matched for ALIST."
 					 (delete ret (copy-alist calist)))
 					))))
 		   (setq values (cdr values)))
-		 (setcdr ctree (list* '(t)
-				      (cons (cdr ret)
-					    (calist-to-ctree
-					     (delete ret (copy-alist calist))))
-				      (cdr ctree)))
-		 )
+		 (if (assq t (cdr ctree))
+		     (setcdr ctree
+			     (cons (cons (cdr ret)
+					 (calist-to-ctree
+					  (delete ret (copy-alist calist))))
+				   (cdr ctree)))
+		   (setcdr ctree
+			   (list* (list t)
+				  (cons (cdr ret)
+					(calist-to-ctree
+					 (delete ret (copy-alist calist))))
+				  (cdr ctree)))
+		   ))
 	     (catch 'tag
 	       (while values
 		 (let ((cell (car values)))
@@ -239,10 +258,16 @@ even if other rules are matched for ALIST."
 			   (ctree-add-calist-with-default (cdr cell) calist))
 		   )
 		 (setq values (cdr values)))
-	       (let ((elt (cons t (calist-to-ctree calist))))
-		 (or (member elt (cdr ctree))
-		     (setcdr ctree (cons elt (cdr ctree)))
-		     )))
+	       (let ((cell (assq t (cdr ctree))))
+		 (if cell
+		     (setcdr cell
+			     (ctree-add-calist-with-default (cdr cell)
+							    calist))
+		   (let ((elt (cons t (calist-to-ctree calist))))
+		     (or (member elt (cdr ctree))
+			 (setcdr ctree (cons elt (cdr ctree)))
+			 ))
+		   )))
 	     )
 	   ctree))))