xapian-bindings/tcl8/tcl.i

   1 %module xapian
   2 %{
   3 /* tcl.i: SWIG interface file for the Tcl bindings
   4  *
   5  * Copyright (c) 2006,2007,2011,2012,2015 Olly Betts
   6  *
   7  * This program is free software; you can redistribute it and/or
   8  * modify it under the terms of the GNU General Public License as
   9  * published by the Free Software Foundation; either version 2 of the
  10  * License, or (at your option) any later version.
  11  *
  12  * This program is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with this program; if not, write to the Free Software
  19  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301
  20  * USA
  21  */
  22 %}
  23
  24 %include ../xapian-head.i
  25
  26 %{
  27 namespace Xapian {
  28     Query *get_tcl8_query(Tcl_Interp *interp, Tcl_Obj *obj) {
  29         Query * retval = 0;
  30         if (SWIG_ConvertPtr(obj, (void **)&retval,
  31                             SWIGTYPE_p_Xapian__Query, 0) != TCL_OK) {
  32             retval = 0;
  33         }
  34         return retval;
  35     }
  36 }
  37 %}
  38
  39 #define XAPIAN_MIXED_SUBQUERIES_BY_ITERATOR_TYPEMAP
  40
  41 %typemap(typecheck, precedence=100) (XapianSWIGQueryItor qbegin, XapianSWIGQueryItor qend) {
  42     int dummy;
  43     $1 = (Tcl_ListObjLength(interp, $input, &dummy) == TCL_OK);
  44     /* FIXME: if we add more array typemaps, we'll need to check the elements
  45      * of the array here to disambiguate. */
  46 }
  47
  48 %{
  49 class XapianSWIGQueryItor {
  50     Tcl_Interp *interp;
  51
  52     Tcl_Obj ** items;
  53
  54     int n;
  55
  56   public:
  57     typedef std::random_access_iterator_tag iterator_category;
  58     typedef Xapian::Query value_type;
  59     typedef Xapian::termcount_diff difference_type;
  60     typedef Xapian::Query * pointer;
  61     typedef Xapian::Query & reference;
  62
  63     XapianSWIGQueryItor()
  64         : n(0) { }
  65
  66     XapianSWIGQueryItor(Tcl_Interp * interp_, Tcl_Obj **items_, int n_)
  67         : interp(interp_), items(items_), n(n_) { }
  68
  69     XapianSWIGQueryItor & operator++() {
  70         ++items;
  71         --n;
  72         return *this;
  73     }
  74
  75     Xapian::Query operator*() const {
  76         Tcl_Obj * item = *items;
  77         Xapian::Query * subq = Xapian::get_tcl8_query(interp, item);
  78         if (subq)
  79             return *subq;
  80
  81         int len;
  82         const char *p = Tcl_GetStringFromObj(item, &len);
  83         return Xapian::Query(string(p, len));
  84     }
  85
  86     bool operator==(const XapianSWIGQueryItor & o) {
  87         return n == o.n;
  88     }
  89
  90     bool operator!=(const XapianSWIGQueryItor & o) {
  91         return !(*this == o);
  92     }
  93
  94     difference_type operator-(const XapianSWIGQueryItor &o) const {
  95         // Note: n counts *DOWN*, so reverse subtract.
  96         return o.n - n;
  97     }
  98 };
  99
 100 %}
 101
 102 %typemap(in) (XapianSWIGQueryItor qbegin, XapianSWIGQueryItor qend) {
 103     Tcl_Obj ** items;
 104     int numitems;
 105     if (Tcl_ListObjGetElements(interp, $input, &numitems, &items) != TCL_OK) {
 106         return TCL_ERROR;
 107     }
 108     $1 = XapianSWIGQueryItor(interp, items, numitems);
 109     // $2 is default initialised where SWIG declares it.
 110 }
 111
 112 #define XAPIAN_TERMITERATOR_PAIR_OUTPUT_TYPEMAP
 113 %typemap(out) std::pair<Xapian::TermIterator, Xapian::TermIterator> {
 114     Tcl_Obj * list = Tcl_NewListObj(0, NULL);
 115
 116     for (Xapian::TermIterator i = $1.first; i != $1.second; ++i) {
 117         Tcl_Obj * str = Tcl_NewStringObj((*i).data(), (*i).length());
 118         if (Tcl_ListObjAppendElement(interp, list, str) != TCL_OK)
 119             return TCL_ERROR;
 120     }
 121     Tcl_SetObjResult(interp, list);
 122 }
 123
 124 // Custom Tcl exception handling:
 125
 126 %{
 127 static int XapianTclHandleError(Tcl_Interp * interp, const Xapian::Error &e) {
 128     Tcl_ResetResult(interp);
 129     Tcl_SetErrorCode(interp, "XAPIAN", e.get_type(), NULL);
 130     Tcl_AppendResult(interp, e.get_msg().c_str(), NULL);
 131     return TCL_ERROR;
 132 }
 133
 134 static int XapianTclHandleError(Tcl_Interp * interp) {
 135     Tcl_ResetResult(interp);
 136     Tcl_SetErrorCode(interp, "XAPIAN ?", NULL);
 137     Tcl_AppendResult(interp, "Unknown Error", NULL);
 138     return TCL_ERROR;
 139 }
 140 %}
 141
 142 %exception {
 143     try {
 144         $function
 145     } catch (const Xapian::Error &e) {
 146         return XapianTclHandleError(interp, e);
 147     } catch (...) {
 148         return XapianTclHandleError(interp);
 149     }
 150 }
 151
 152 %include ../xapian-headers.i
 153
 154 /* vim:set syntax=cpp: */