static uim_lisp
notify_fatal(uim_lisp msg_)
{
const char *msg = REFER_C_STR(msg_);
return MAKE_BOOL(uim_notify_fatal("%s", msg));
}
SCM_EXPORT ScmObj
scm_p_booleanp(ScmObj obj)
{
DECLARE_FUNCTION("boolean?", procedure_fixed_1);
return MAKE_BOOL(EQ(obj, SCM_FALSE) || EQ(obj, SCM_TRUE));
}
/* The name 'error?' should be reserved for SRFI-35 */
SCM_EXPORT ScmObj
scm_p_error_objectp(ScmObj obj)
{
DECLARE_FUNCTION("%%error-object?", procedure_fixed_1);
return MAKE_BOOL(CONSP(obj) && EQ(CAR(obj), l_err_obj_tag));
}
/*=======================================
R5RS : 6.4 Control Features
=======================================*/
SCM_EXPORT ScmObj
scm_p_procedurep(ScmObj obj)
{
DECLARE_FUNCTION("procedure?", procedure_fixed_1);
return MAKE_BOOL(PROCEDUREP(obj));
}
static uim_lisp
notify_load(uim_lisp name_)
{
const char *name = REFER_C_STR(name_);
return MAKE_BOOL(uim_notify_load(name));
}
/*===========================================================================
R5RS : 6.1 Equivalence predicates
===========================================================================*/
SCM_EXPORT ScmObj
scm_p_eqp(ScmObj obj1, ScmObj obj2)
{
DECLARE_FUNCTION("eq?", procedure_fixed_2);
return MAKE_BOOL(EQ(obj1, obj2));
}
static uim_lisp
setugidp(void)
{
assert(uim_scm_gc_any_contextp());
return MAKE_BOOL(uim_issetugid());
}
/*===========================================================================
R5RS : 6.3 Other data types : 6.3.1 Booleans
===========================================================================*/
SCM_EXPORT ScmObj
scm_p_not(ScmObj obj)
{
DECLARE_FUNCTION("not", procedure_fixed_1);
return MAKE_BOOL(FALSEP(obj));
}
/*===========================================================================
R5RS : 6.3 Other data types : 6.3.3 Symbols
===========================================================================*/
SCM_EXPORT ScmObj
scm_p_symbolp(ScmObj obj)
{
DECLARE_FUNCTION("symbol?", procedure_fixed_1);
return MAKE_BOOL(SYMBOLP(obj));
}
SCM_EXPORT ScmObj
scm_p_eqvp(ScmObj obj1, ScmObj obj2)
{
#if SCM_HAS_EQVP
#define scm_p_eqvp error_eqvp_recursed__ /* Safety measure. */
return EQVP(obj1, obj2);
#undef scm_p_eqvp
#else /* don't have inlined EQVP() */
#if (!(SCM_HAS_IMMEDIATE_NUMBER_ONLY && SCM_HAS_IMMEDIATE_CHAR_ONLY))
enum ScmObjType type;
#endif
DECLARE_FUNCTION("eqv?", procedure_fixed_2);
if (EQ(obj1, obj2))
return SCM_TRUE;
#if (!(SCM_HAS_IMMEDIATE_NUMBER_ONLY && SCM_HAS_IMMEDIATE_CHAR_ONLY))
type = SCM_TYPE(obj1);
/* different type */
if (type != SCM_TYPE(obj2))
return SCM_FALSE;
/* same type */
switch (type) {
#if (SCM_USE_INT && !SCM_HAS_IMMEDIATE_INT_ONLY)
case ScmInt:
return MAKE_BOOL(SCM_INT_VALUE(obj1) == SCM_INT_VALUE(obj2));
#endif
#if (SCM_USE_CHAR && !SCM_HAS_IMMEDIATE_CHAR_ONLY)
case ScmChar:
return MAKE_BOOL(SCM_CHAR_VALUE(obj1) == SCM_CHAR_VALUE(obj2));
#endif
default:
break;
}
#endif /* (!(SCM_HAS_IMMEDIATE_NUMBER_ONLY && SCM_HAS_IMMEDIATE_CHAR_ONLY)) */
return SCM_FALSE;
#endif /* don't have inlined EQVP() */
}
SCM_EXPORT ScmObj
scm_p_pair_mutablep(ScmObj kons)
{
DECLARE_FUNCTION("%%pair-mutable?", procedure_fixed_1);
ENSURE_CONS(kons);
return MAKE_BOOL(SCM_CONS_MUTABLEP(kons));
}
/*
* TODO: replace original specification with a SRFI standard or other de facto
* standard
*/
SCM_EXPORT ScmObj
scm_p_providedp(ScmObj feature)
{
DECLARE_FUNCTION("provided?", procedure_fixed_1);
ENSURE_STRING(feature);
return MAKE_BOOL(scm_providedp(feature));
}
static uim_lisp
c_setenv(uim_lisp name, uim_lisp val, uim_lisp overwrite)
{
int err;
err = setenv(REFER_C_STR(name), REFER_C_STR(val), TRUEP(overwrite));
return MAKE_BOOL(!err);
}
SCM_EXPORT ScmObj
scm_p_srfi60_logtest(ScmObj j, ScmObj k)
{
DECLARE_FUNCTION("logtest", procedure_fixed_2);
ENSURE_INT(j);
ENSURE_INT(k);
return MAKE_BOOL(SCM_INT_VALUE(j) & SCM_INT_VALUE(k));
}
static uim_lisp
file_stat_mode(uim_lisp filename, mode_t mode)
{
struct stat st;
int err;
err = stat(REFER_C_STR(filename), &st);
if (err)
return uim_scm_f(); /* intentionally returns #f instead of error */
return MAKE_BOOL((st.st_mode & mode) == mode);
}
static uim_lisp
im_convertiblep(uim_lisp uc_, uim_lisp im_encoding_)
{
uim_context uc;
const char *im_encoding;
uim_bool convertiblep;
uc = retrieve_uim_context(uc_);
im_encoding = REFER_C_STR(im_encoding_);
convertiblep = uc->conv_if->is_convertible(uc->client_encoding, im_encoding);
return MAKE_BOOL(convertiblep);
}
static uim_lisp
commit_nth_prediction(uim_lisp ac_, uim_lisp nth_)
{
#ifdef HAS_ANTHY_COMMIT_PREDICTION
anthy_context_t ac;
int nth, err;
ac = get_anthy_context(ac_);
nth = C_INT(nth_);
err = anthy_commit_prediction(ac, nth);
return MAKE_BOOL(!err);
#else
return uim_scm_f();
#endif
}
/* The implementation is fully compatible with SIOD */
SCM_EXPORT ScmObj
scm_p_symbol_boundp(ScmObj sym, ScmObj rest)
{
ScmObj env;
ScmRef ref;
DECLARE_FUNCTION("symbol-bound?", procedure_variadic_1);
ENSURE_SYMBOL(sym);
if (NULLP(rest)) {
env = SCM_INTERACTION_ENV;
} else {
env = POP(rest);
ASSERT_NO_MORE_ARG(rest);
ENSURE_VALID_ENV(env);
}
ref = scm_lookup_environment(sym, env);
return MAKE_BOOL(ref != SCM_INVALID_REF || SCM_SYMBOL_BOUNDP(sym));
}
static uim_lisp
im_delete_text(uim_lisp uc_, uim_lisp text_id_, uim_lisp origin_,
uim_lisp former_len_, uim_lisp latter_len_)
{
uim_context uc;
int err, former_len, latter_len;
enum UTextArea text_id;
enum UTextOrigin origin;
uc = retrieve_uim_context(uc_);
if (!uc->delete_text_cb)
return uim_scm_f();
text_id = C_INT(text_id_);
origin = C_INT(origin_);
former_len = C_INT(former_len_);
latter_len = C_INT(latter_len_);
err = uc->delete_text_cb(uc->ptr, text_id, origin, former_len, latter_len);
return MAKE_BOOL(!err);
}
SKERR SKIndex::ConfigureItem(char* pszSection, char* pszToken, char* pszValue)
{
SKERR err = err_not_handled;
if(!pszToken)
return noErr;
if(!PL_strcmp(pszSection, "WORDTABLE"))
{
if(!PL_strcmp(pszToken, "DOCLINKFIELD"))
{
if(m_pWordRecordSet)
{
skPtr<SKIFldCollection> pCol;
err = m_pWordRecordSet->GetFldCollection(
pCol.already_AddRefed());
if(err == noErr)
err = pCol->GetField(pszValue,
m_pDocLinkField.already_AddRefed());
}
else
{
err = err_config;
}
}
else if(!PL_strcmp(pszToken, "DOCIDFIELD"))
{
if(m_pDocLinkField)
{
skPtr<SKIRecordSet> pLinkRS;
err = m_pDocLinkField->GetLinkSubRecordSet(
pLinkRS.already_AddRefed());
if(err == noErr)
{
skPtr<SKIFldCollection> pCol;
err = pLinkRS->GetFldCollection(
pCol.already_AddRefed());
if(err == noErr)
err = pCol->GetField(pszValue,
m_pDocIdField.already_AddRefed());
}
}
else
{
err = err_config;
}
}
else if(!PL_strcmp(pszToken, "STRUCTUREFIELD"))
{
if(!*pszValue)
err = noErr;
else if(m_pDocLinkField)
{
skPtr<SKIRecordSet> pLinkRS;
err = m_pDocLinkField->GetLinkSubRecordSet(
pLinkRS.already_AddRefed());
if(err == noErr)
{
skPtr<SKIFldCollection> pCol;
err = pLinkRS->GetFldCollection(
pCol.already_AddRefed());
if(err == noErr)
err = pCol->GetField(pszValue,
m_pStructureField.already_AddRefed());
}
}
else
{
err = err_config;
}
}
else if(!PL_strcmp(pszToken, "OCCLINKFIELD"))
{
if(!*pszValue)
err = noErr;
else if(m_pDocLinkField)
{
skPtr<SKIRecordSet> pLinkRS;
err = m_pDocLinkField->GetLinkSubRecordSet(
pLinkRS.already_AddRefed());
if(err == noErr)
{
skPtr<SKIFldCollection> pCol;
err = pLinkRS->GetFldCollection(
pCol.already_AddRefed());
if(err == noErr)
err = pCol->GetField(pszValue,
m_pOccLinkField.already_AddRefed());
}
}
else
{
err = err_config;
}
}
else if(!PL_strcmp(pszToken, "OCCFIELD"))
{
if(!*pszValue)
err = noErr;
else if(m_pOccLinkField)
{
skPtr<SKIRecordSet> pLinkRS;
err = m_pOccLinkField->GetLinkSubRecordSet(
pLinkRS.already_AddRefed());
if(err == noErr)
{
skPtr<SKIFldCollection> pCol;
err = pLinkRS->GetFldCollection(
pCol.already_AddRefed());
if(err == noErr)
err = pCol->GetField(pszValue,
m_pOccField.already_AddRefed());
}
}
else
{
err = err_config;
}
}
}
// [WILDCARDWORDLIST]
else if(!PL_strcmp(pszSection, "WILDCARDWORDLIST"))
{
if(!PL_strcmp(pszToken, "PATH"))
{
*m_pWordList.already_AddRefed() =
sk_CreateInstance(SKWildCardWordList)();
if(m_pWordList)
{
err = m_pWordList->SetFileName(pszValue);
if(err == noErr)
err = m_pWordList->GetWordRecordSet(
m_pWordRecordSet.already_AddRefed());
}
else
{
err = err_memory;
}
}
}
// [SEPARATORS]
else if (!PL_strcmp(pszSection, "SEPARATORS"))
{
if(!PL_strcmp(pszToken, "HARD"))
{
*m_pHardSepList.already_AddRefed() =
sk_CreateInstance(SKIntegerList)();
if (m_pHardSepList)
err = m_pHardSepList->SetListFromAsciiString(pszValue);
else
err = err_memory;
} else
if(!PL_strcmp(pszToken, "SOFT"))
{
*m_pSoftSepList.already_AddRefed() =
sk_CreateInstance(SKIntegerList)();
if (m_pSoftSepList)
err = m_pSoftSepList->SetListFromAsciiString(pszValue);
else
err = err_memory;
} else
if (!PL_strcmp(pszToken, "EXCEPTIONS"))
{
*m_pSoftSepExcList.already_AddRefed() =
sk_CreateInstance(SKStringList)();
if (m_pSoftSepExcList)
err = m_pSoftSepExcList->SetFileName(pszValue);
else
err = err_memory;
} else err = err_config;
}
// [STOPWORDLIST]
else if (!PL_strcmp(pszSection, "STOPWORDLIST"))
{
if(!PL_strcmp(pszToken, "PATH"))
{
*m_pStopWordList.already_AddRefed() =
sk_CreateInstance(SKStringList)();
if (m_pStopWordList)
err = m_pStopWordList->SetFileName(pszValue);
else
err = err_memory;
} else err = err_config;
}
// [LINKS]
else if (!PL_strcmp(pszSection, "LINKS"))
{
PRUint32 lLink = 0;
if (!PL_strcmp(pszToken, "COUNT"))
{
PRUint32 i;
m_lLinkCount = atoi(pszValue);
__CleanPpsz(m_ppszLinkNames);
err = noErr;
m_ppszLinkNames =
(char **)PR_Malloc(sizeof(char *) * m_lLinkCount);
if (m_ppszLinkNames == NULL)
err = SKError(err_idx_malloc, "[SKIndex::SetFileName] "
"Can not allocate memory");
__CleanPpsz(m_ppszSubLinkNames);
m_ppszSubLinkNames =
(char **)PR_Malloc(sizeof(char *) * m_lLinkCount);
if (m_ppszSubLinkNames == NULL)
err = SKError(err_idx_malloc, "[SKIndex::SetFileName] "
"Can not allocate memory");
m_pbMerge = (PRBool*) PR_Malloc(sizeof(PRBool) * m_lLinkCount);
if (m_pbMerge == NULL)
err = SKError(err_idx_malloc, "[SKIndex::SetFileName] "
"Can not allocate memory");
for(i = 0 ; i < m_lLinkCount ; i++)
{
m_ppszLinkNames[i] = NULL;
m_ppszSubLinkNames[i] = NULL;
m_pbMerge[i] = PR_FALSE;
}
}
else if(!PL_strncmp(pszToken, "FIELD", 5))
{
err = noErr;
if (pszToken[5] != ',')
{
err = SKError(err_idx_invalid, "[SKIndex::SetFileName] "
"Missing comma after FIELD");
}
lLink = atoi(pszToken + 6)-1;
if (lLink >= m_lLinkCount)
{
err = SKError(err_idx_invalid, "[SKIndex::SetFileName] "
"Bad link number value for FIELD: %d", lLink);
}
__CleanPsz(m_ppszLinkNames[lLink]);
m_ppszLinkNames[lLink] = PL_strdup(pszValue);
}
else if(!PL_strncmp(pszToken, "SUBFIELD", 8))
{
err = noErr;
if (pszToken[8] != ',')
{
err = SKError(err_idx_invalid, "[SKIndex::SetFileName] "
"Missing comma after SUBFIELD");
}
lLink = atoi(pszToken + 9)-1;
if (lLink >= m_lLinkCount)
{
err = SKError(err_idx_invalid, "[SKIndex::SetFileName] "
"Bad link number value for SUBFIELD: %d", lLink);
}
__CleanPsz(m_ppszSubLinkNames[lLink]);
m_ppszSubLinkNames[lLink] = PL_strdup(pszValue);
}
else if(!PL_strncmp(pszToken, "MERGE", 5))
{
err = noErr;
if (pszToken[5] != ',')
{
err = SKError(err_idx_invalid, "[SKIndex::SetFileName] "
"Missing comma after MERGE");
}
lLink = atoi(pszToken + 6)-1;
if (lLink >= m_lLinkCount)
{
err = SKError(err_idx_invalid, "[SKIndex::SetFileName] "
"Bad link number value for MERGE: %d", lLink);
}
m_pbMerge[lLink] = MAKE_BOOL(pszValue);
}
}
return err;
}
// sample: myinc:///System/Window/Close#HelloWindow
// func = Window/Close
// arg = HelloWindow
QVariant DSystemFuncs::run(const QString &func,
const QStringList &arg,
const QObject * nativeSender
)
{
QStringList f = (func.toLower()).split('/', QString::SkipEmptyParts );
if (f.count() <= 1)
return g_vErr;
const QString* tmp = &f.at(0);
if ( *tmp == QString("window") ) { /// window funcs
tmp = &f.at(1);
if ( *tmp == QString("close") ) {
DSystemFuncs::closeWidget( arg.count() != 0 ?
arg.at(0):
nativeSender->objectName() );
return g_vSuc;
} else if ( *tmp == QString("open")) {
return MAKE_BOOL(DSystemFuncs::openWidget( arg.at(0) ));
} else if ( *tmp == "object") {
if ((arg.count() == 0) || (arg.count() > 4))
return g_vErr;
int c = arg.count();
return DSystemFuncs::object( c==2?nativeSender->objectName():arg.at(0),
arg.at(c - 2),
arg.at(c - 1) );
} else if ( *tmp == "setobject" ) {
if ((arg.count() == 0) || (arg.count() > 4))
return g_vErr;
int c = arg.count();
DSystemFuncs::setObject( c == 3 ? nativeSender->objectName() : arg.at(0),
arg.at(1), arg.at(2), arg.at(3) );
return g_vSuc;
} else if ( *tmp == "refresh" ) {
return MAKE_BOOL(refreshWidget(
(arg.count() == 0)?
nativeSender->objectName():
arg.at(0)
));
}
} else if ( *tmp == QString("var") ) { // variable funcs
tmp = &f.at(1);
if (arg.count() < 1) {
return g_vErr;
}
if ( *tmp == QString("global") ) { /// this is Global Variables
if (f.count() != 3)
return g_vErr;
tmp = &f.at(2);
if (*tmp == QString("get"))
return getGlobalVariable( arg.at(0) );
else if (*tmp == QString("set")) {
if (arg.count() < 2 )
return g_vErr;
setGlobalVariable( arg.at(0), arg.at(1) );
return g_vSuc;
}
} else if ( *tmp == QString("local")) {
if (f.count() != 3)
return g_vErr;
if (arg.count() < 2 )
return g_vErr;
tmp = &f.at(2);
if (*tmp == QString("get"))
return DSystemFuncs::getVariable( arg.at(0), arg.at(1) );
else if (*tmp == QString("set")) {
if (arg.count() < 3 )
return g_vErr;
DSystemFuncs::setVariable( arg.at(0), arg.at(1), arg.at(2) );
return g_vSuc;
}
}
} else if ( *tmp == g_sNull.toLower() )
return g_vNull;
else if ( *tmp == "succses" )
return g_vSuc;
else if ( *tmp == "error" )
return g_vErr;
return g_vErr;
}
SCM_EXPORT ScmObj
scm_p_equalp(ScmObj obj1, ScmObj obj2)
{
enum ScmObjType type;
ScmObj elm1, elm2;
#if SCM_USE_VECTOR
ScmObj *v1, *v2;
scm_int_t i, len;
#endif
DECLARE_FUNCTION("equal?", procedure_fixed_2);
if (EQ(obj1, obj2))
return SCM_TRUE;
type = SCM_TYPE(obj1);
/* different type */
if (type != SCM_TYPE(obj2))
return SCM_FALSE;
/* same type */
switch (type) {
#if (SCM_USE_INT && !SCM_HAS_IMMEDIATE_INT_ONLY)
case ScmInt:
return MAKE_BOOL(SCM_INT_VALUE(obj1) == SCM_INT_VALUE(obj2));
#endif
#if (SCM_USE_CHAR && !SCM_HAS_IMMEDIATE_CHAR_ONLY)
case ScmChar:
return MAKE_BOOL(SCM_CHAR_VALUE(obj1) == SCM_CHAR_VALUE(obj2));
#endif
#if SCM_USE_STRING
case ScmString:
return MAKE_BOOL(STRING_EQUALP(obj1, obj2));
#endif
case ScmCons:
for (; CONSP(obj1) && CONSP(obj2); obj1 = CDR(obj1), obj2 = CDR(obj2))
{
elm1 = CAR(obj1);
elm2 = CAR(obj2);
if (!EQ(elm1, elm2)
&& (SCM_TYPE(elm1) != SCM_TYPE(elm2)
|| !EQUALP(elm1, elm2)))
return SCM_FALSE;
}
/* compare last cdr */
return (EQ(obj1, obj2)) ? SCM_TRUE : scm_p_equalp(obj1, obj2);
#if SCM_USE_VECTOR
case ScmVector:
len = SCM_VECTOR_LEN(obj1);
if (len != SCM_VECTOR_LEN(obj2))
return SCM_FALSE;
v1 = SCM_VECTOR_VEC(obj1);
v2 = SCM_VECTOR_VEC(obj2);
for (i = 0; i < len; i++) {
elm1 = v1[i];
elm2 = v2[i];
if (!EQ(elm1, elm2)
&& (SCM_TYPE(elm1) != SCM_TYPE(elm2)
|| !EQUALP(elm1, elm2)))
return SCM_FALSE;
}
return SCM_TRUE;
#endif
#if SCM_USE_SSCM_EXTENSIONS
case ScmCPointer:
return MAKE_BOOL(SCM_C_POINTER_VALUE(obj1)
== SCM_C_POINTER_VALUE(obj2));
case ScmCFuncPointer:
return MAKE_BOOL(SCM_C_FUNCPOINTER_VALUE(obj1)
== SCM_C_FUNCPOINTER_VALUE(obj2));
#endif
default:
break;
}
return SCM_FALSE;
}
