From: Maciej Pasternacki <maciej@pasternacki.net>
Date: Thu, 18 Dec 2008 00:08:16 +0000 (+0100)
Subject: - New function: TRANE-TAXONOMY:TERM-SYNONYMS
X-Git-Url: https://repo.or.cz/w/cl-trane.git/commitdiff_plain/008dbfdebf0291abf568d4fa20cad48dc297d2d7

- New function: TRANE-TAXONOMY:TERM-SYNONYMS
---

diff --git a/doc/TRANE-TAXONOMY.html b/doc/TRANE-TAXONOMY.html
index 76f38cb..e469523 100644
--- a/doc/TRANE-TAXONOMY.html
+++ b/doc/TRANE-TAXONOMY.html
@@ -56,7 +56,18 @@ Applicable to taxonomy objects, symbols and strings.</blockquote><p><b>term</b>&
 <blockquote>Class init args: <tt> :text :taxonomy-name :description</tt></blockquote>
 <p>(<b>term-item-ids</b> term)&nbsp;&nbsp;&nbsp;<i>function</i></p>
 <blockquote>IDs of items associated with given TERM.</blockquote><p>(<b>term-items</b> term)&nbsp;&nbsp;&nbsp;<i>function</i></p>
-<blockquote>Items associated with given TERM.</blockquote><p>(<b>term-taxonomy</b> term)&nbsp;&nbsp;&nbsp;<i>function</i></p>
+<blockquote>Items associated with given TERM.</blockquote><p>(<b>term-synonyms</b> term)&nbsp;&nbsp;&nbsp;<i>function</i></p>
+<blockquote>Return list of terms synonymous with TERM.
+
+Two terms are synonymous when they are in the same taxonomy and differ
+only in case.  More special cases for synonymity may be introduced
+later.
+
+TERM is always included in the returned list, and it is a first item.
+
+TERM may be also a list, whose first element is taxonomy object or
+name, and second element is term name.  This is a case of premature
+optimization.</blockquote><p>(<b>term-taxonomy</b> term)&nbsp;&nbsp;&nbsp;<i>function</i></p>
 <blockquote>TERM's taxonomy object</blockquote><p><b>TERM-TAXONOMY-NAME</b></p>&nbsp;&nbsp;&nbsp;<i><font color="FF0000">undocumented</font></i></p>
 <p><b>TERM-TEXT</b></p>&nbsp;&nbsp;&nbsp;<i><font color="FF0000">undocumented</font></i></p>
 <p>(<b>term-value</b> item term)&nbsp;&nbsp;&nbsp;<i>function</i></p>
diff --git a/src/taxonomy.lisp b/src/taxonomy.lisp
index 5cd8204..644d6b7 100644
--- a/src/taxonomy.lisp
+++ b/src/taxonomy.lisp
@@ -15,7 +15,7 @@
            #:cl-store-valued-taxonomy #:deftaxonomy #:ensure-taxonomy
            #:ensure-term #:term #:term-text
            #:slug #:term-taxonomy-name
-           #:description #:term-taxonomy
+           #:description #:term-taxonomy #:term-synonyms
            #:id #:find-terms #:new-term #:apply-term
            #:term-value #:item-terms #:order-item-terms
            #:unbind-term :term-item-ids #:term-items
@@ -275,6 +275,30 @@ creation."
                                                                                :slug slug))
                                       'term-text))))
 
+(defun term-synonyms (term)
+  "Return list of terms synonymous with TERM.
+
+Two terms are synonymous when they are in the same taxonomy and differ
+only in case.  More special cases for synonymity may be introduced
+later.
+
+TERM is always included in the returned list, and it is a first item.
+
+TERM may be also a list, whose first element is taxonomy object or
+name, and second element is term name.  This is a case of premature
+optimization."
+  (query-dao 'term
+             (sql (:select '* :from 'term
+                           :where (:and (:= 'term-taxonomy
+                                            (taxonomy-slug
+                                             (etypecase term
+                                               (term (term-taxonomy term))
+                                               (list (first term)))))
+                                        (:= (:lower 'term-text)
+                                            (:lower (etypecase term
+                                                      (term (term-text term))
+                                                      (list (string (second term)))))))))))
+
 (defun apply-term (item term &key value order)
   "Apply TERM to ITEM, optionally setting its value to VALUE."
   (query (:insert-into 'item-term :set