1/* -----------------------------------------------------------------------------
2 * See the LICENSE file for information on copyright, usage and redistribution
3 * of SWIG, and the README file for authors - http://www.swig.org/release.html.
4 *
5 * std_string.i
6 *
7 * SWIG typemaps for std::string
8 * ----------------------------------------------------------------------------- */
9
10// ------------------------------------------------------------------------
11// std::string is typemapped by value
12// This can prevent exporting methods which return a string
13// in order for the user to modify it.
14// However, I think I'll wait until someone asks for it...
15// ------------------------------------------------------------------------
16
17%include <exception.i>
18
19%{
20#include <string>
21#include <vector>
22    using std::string;
23    using std::vector;
24%}
25
26%include <std_vector.i>
27
28%naturalvar std::string;
29%naturalvar std::wstring;
30
31namespace std {
32    template <class charT> class basic_string {
33    public:
34	typedef charT *pointer;
35	typedef charT &reference;
36	typedef const charT &const_reference;
37	typedef size_t size_type;
38	typedef ptrdiff_t difference_type;
39	basic_string();
40	basic_string( charT *str );
41	size_t size();
42	charT operator []( int pos ) const;
43	charT *c_str() const;
44	basic_string<charT> &operator = ( const basic_string &ws );
45	basic_string<charT> &operator = ( const charT *str );
46	basic_string<charT> &append( const basic_string<charT> &other );
47	basic_string<charT> &append( const charT *str );
48	void push_back( charT c );
49	void clear();
50	void reserve( size_type t );
51	void resize( size_type n, charT c = charT() );
52	int compare( const basic_string<charT> &other ) const;
53	int compare( const charT *str ) const;
54	basic_string<charT> &insert( size_type pos,
55				     const basic_string<charT> &str );
56	size_type find( const basic_string<charT> &other, int pos = 0 ) const;
57	size_type find( charT c, int pos = 0 ) const;
58	%extend {
59	    bool operator == ( const basic_string<charT> &other ) const {
60		return self->compare( other ) == 0;
61	    }
62	    bool operator != ( const basic_string<charT> &other ) const {
63		return self->compare( other ) != 0;
64	    }
65	    bool operator < ( const basic_string<charT> &other ) const {
66		return self->compare( other ) == -1;
67	    }
68	    bool operator > ( const basic_string<charT> &other ) const {
69		return self->compare( other ) == 1;
70	    }
71	    bool operator <= ( const basic_string<charT> &other ) const {
72		return self->compare( other ) != 1;
73	    }
74	    bool operator >= ( const basic_string<charT> &other ) const {
75		return self->compare( other ) != -1;
76	    }
77	}
78    };
79
80    %template(string) basic_string<char>;
81    %template(wstring) basic_string<wchar_t>;
82    typedef basic_string<char> string;
83    typedef basic_string<wchar_t> wstring;
84
85    /* Overloading check */
86    %typemap(in) string {
87        if (caml_ptr_check($input))
88            $1.assign((char *)caml_ptr_val($input,0),
89                      caml_string_len($input));
90        else
91            SWIG_exception(SWIG_TypeError, "string expected");
92    }
93
94    %typemap(in) const string & (std::string temp) {
95        if (caml_ptr_check($input)) {
96            temp.assign((char *)caml_ptr_val($input,0),
97                        caml_string_len($input));
98            $1 = &temp;
99        } else {
100            SWIG_exception(SWIG_TypeError, "string expected");
101        }
102    }
103
104    %typemap(in) string & (std::string temp) {
105        if (caml_ptr_check($input)) {
106            temp.assign((char *)caml_ptr_val($input,0),
107                        caml_string_len($input));
108            $1 = &temp;
109        } else {
110            SWIG_exception(SWIG_TypeError, "string expected");
111        }
112    }
113
114    %typemap(in) string * (std::string *temp) {
115        if (caml_ptr_check($input)) {
116            temp = new std::string((char *)caml_ptr_val($input,0),
117				   caml_string_len($input));
118            $1 = temp;
119        } else {
120            SWIG_exception(SWIG_TypeError, "string expected");
121        }
122    }
123
124    %typemap(free) string * (std::string *temp) {
125	delete temp;
126    }
127
128    %typemap(argout) string & {
129	caml_list_append(swig_result,caml_val_string_len((*$1).c_str(),
130							 (*$1).size()));
131    }
132
133    %typemap(directorout) string {
134	$result.assign((char *)caml_ptr_val($input,0),
135		       caml_string_len($input));
136    }
137
138    %typemap(out) string {
139        $result = caml_val_string_len($1.c_str(),$1.size());
140    }
141
142    %typemap(out) string * {
143	$result = caml_val_string_len((*$1).c_str(),(*$1).size());
144    }
145}
146
147#ifdef ENABLE_CHARPTR_ARRAY
148char **c_charptr_array( const std::vector <string > &str_v );
149
150%{
151  SWIGEXT char **c_charptr_array( const std::vector <string > &str_v ) {
152    char **out = new char *[str_v.size() + 1];
153    out[str_v.size()] = 0;
154    for( int i = 0; i < str_v.size(); i++ ) {
155      out[i] = (char *)str_v[i].c_str();
156    }
157    return out;
158  }
159%}
160#endif
161
162#ifdef ENABLE_STRING_VECTOR
163%template (StringVector) std::vector<string >;
164
165%insert(ml) %{
166  (* Some STL convenience items *)
167
168  let string_array_to_vector sa =
169    let nv = _new_StringVector C_void in
170      array_to_vector nv (fun x -> C_string x) sa ; nv
171
172  let c_string_array ar =
173    _c_charptr_array (string_array_to_vector ar)
174%}
175
176%insert(mli) %{
177  val c_string_array: string array -> c_obj
178%}
179#endif
180