00001 /** @file tcl/namesp.cc Thin wrapper around Tcl_Namespace */ 00002 00003 /////////////////////////////////////////////////////////////////////// 00004 // 00005 // Copyright (c) 2006-2007 University of Southern California 00006 // Rob Peters <rjpeters at usc dot edu> 00007 // 00008 // created: Fri Feb 17 17:01:19 2006 00009 // commit: $Id: namesp.cc 11876 2009-10-22 15:53:06Z icore $ 00010 // $HeadURL: svn://isvn.usc.edu/software/invt/trunk/saliency/src/tcl/namesp.cc $ 00011 // 00012 // -------------------------------------------------------------------- 00013 // 00014 // This file is part of GroovX 00015 // [http://www.klab.caltech.edu/rjpeters/groovx/] 00016 // 00017 // GroovX is free software; you can redistribute it and/or modify it 00018 // under the terms of the GNU General Public License as published by 00019 // the Free Software Foundation; either version 2 of the License, or 00020 // (at your option) any later version. 00021 // 00022 // GroovX is distributed in the hope that it will be useful, but 00023 // WITHOUT ANY WARRANTY; without even the implied warranty of 00024 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 00025 // General Public License for more details. 00026 // 00027 // You should have received a copy of the GNU General Public License 00028 // along with GroovX; if not, write to the Free Software Foundation, 00029 // Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA. 00030 // 00031 /////////////////////////////////////////////////////////////////////// 00032 00033 #ifndef GROOVX_TCL_NAMESP_CC_UTC20060218010119_DEFINED 00034 #define GROOVX_TCL_NAMESP_CC_UTC20060218010119_DEFINED 00035 00036 #include "tcl/namesp.h" 00037 00038 #include "tcl/interp.h" 00039 #include "tcl/list.h" 00040 00041 #include "rutz/error.h" 00042 #include "rutz/sfmt.h" 00043 00044 #include "rutz/debug.h" 00045 GVX_DBG_REGISTER 00046 00047 #ifdef HAVE_TCLINT_H 00048 00049 tcl::native_namesp::native_namesp(Tcl_Namespace* ns) 00050 : 00051 m_ns(ns) 00052 {} 00053 00054 tcl::native_namesp::native_namesp(tcl::interpreter& interp, const char* name) 00055 : 00056 m_ns(0) 00057 { 00058 m_ns = 00059 Tcl_FindNamespace(interp.intp(), name, 00060 0 /* namespaceContextPtr*/, TCL_GLOBAL_ONLY); 00061 00062 if (m_ns == 0) 00063 { 00064 m_ns = Tcl_CreateNamespace(interp.intp(), 00065 name, 00066 0 /*clientdata*/, 00067 0 /*delete_proc*/); 00068 } 00069 00070 GVX_ASSERT(m_ns != 0); 00071 } 00072 00073 tcl::native_namesp tcl::native_namesp::lookup(tcl::interpreter& interp, 00074 const char* name) 00075 { 00076 Tcl_Namespace* const ns = 00077 Tcl_FindNamespace(interp.intp(), name, 0, TCL_GLOBAL_ONLY); 00078 00079 if (ns == 0) 00080 throw rutz::error(rutz::sfmt("no Tcl namespace '%s;", name), 00081 SRC_POS); 00082 00083 return tcl::native_namesp(ns); 00084 } 00085 00086 void tcl::native_namesp::export_cmd(tcl::interpreter& interp, 00087 const char* cmdname) const 00088 { 00089 Tcl_Export(interp.intp(), m_ns, cmdname, 00090 /*resetExportListfirst*/ false); 00091 } 00092 00093 tcl::list tcl::native_namesp::get_export_list(tcl::interpreter& interp) const 00094 { 00095 tcl::obj obj; 00096 00097 Tcl_AppendExportList(interp.intp(), m_ns, obj.get()); 00098 00099 return tcl::list(obj); 00100 } 00101 00102 #endif // HAVE_TCLINT_H 00103 00104 00105 tcl::emu_namesp::emu_namesp(tcl::interpreter& /*interp*/, 00106 const char* name) 00107 : 00108 m_ns_name(name) 00109 {} 00110 00111 tcl::emu_namesp tcl::emu_namesp::lookup(tcl::interpreter& interp, 00112 const char* name) 00113 { 00114 return tcl::emu_namesp(interp, name); 00115 } 00116 00117 void tcl::emu_namesp::export_cmd(tcl::interpreter& interp, 00118 const char* cmdname) const 00119 { 00120 interp.eval(rutz::sfmt("namespace eval %s { namespace export %s }", 00121 m_ns_name.c_str(), cmdname)); 00122 } 00123 00124 tcl::list tcl::emu_namesp::get_export_list(tcl::interpreter& interp) const 00125 { 00126 const tcl::obj prevresult = interp.get_result<tcl::obj>(); 00127 interp.reset_result(); 00128 00129 interp.eval(rutz::sfmt("namespace eval %s { namespace export }", 00130 m_ns_name.c_str())); 00131 00132 const tcl::list exportlist = interp.get_result<tcl::list>(); 00133 00134 interp.set_result(prevresult); 00135 00136 return exportlist; 00137 } 00138 00139 static const char __attribute__((used)) vcid_groovx_tcl_namesp_cc_utc20060218010119[] = "$Id: namesp.cc 11876 2009-10-22 15:53:06Z icore $ $HeadURL: svn://isvn.usc.edu/software/invt/trunk/saliency/src/tcl/namesp.cc $"; 00140 #endif // !GROOVX_TCL_NAMESP_CC_UTC20060218010119DEFINED