static Name
getCommentEndSyntax(SyntaxTable t, Int len)
{ if ( isDefault(len) || len == ONE )
{ int i;
for(i=0; i<valInt(t->size); i++)
if ( tiscommentend(t, i) )
{ char buf[2];
buf[0] = (char) i;
buf[1] = EOS;
answer(CtoName(buf));
}
} else
{ int i1, i2;
for(i1=0; i1<valInt(t->size); i1++)
if ( tiscommentend1(t, i1) )
for(i2=0; i2<valInt(t->size); i2++)
if ( tiscommentend2(t, i2) )
{ char buf[3];
buf[0] = (char) i1;
buf[1] = (char) i2;
buf[2] = EOS;
answer(CtoName(buf));
}
}
fail;
}
static status
initialiseSyntaxTable(SyntaxTable t, Name name, SyntaxTable def)
{ unsigned short *flags;
unsigned char *context;
if ( isDefault(name) )
name = NIL;
if ( notDefault(def) )
{ flags = def->table;
context = def->context;
assign(t, sentence_end, def->paragraph_end);
assign(t, paragraph_end, def->paragraph_end);
} else
{ flags = char_flags;
context = char_context;
assign(t, sentence_end,
newObject(ClassRegex, CtoName("[.?!]\\s"), EAV));
assign(t, paragraph_end,
newObject(ClassRegex, CtoName("\\s*\n"), EAV));
}
assign(t, name, name);
assign(t, size, toInt(256));
t->table = alloc(FLAGS_SIZE(t));
t->context = alloc(CONTEXT_SIZE(t));
memcpy(t->table, flags, FLAGS_SIZE(t));
memcpy(t->context, context, CONTEXT_SIZE(t));
if ( notNil(name) )
appendHashTable(SyntaxTables, name, t);
succeed;
}
static status
initialiseC(CObj h)
{ initialiseHost((Host)h, CtoName("C"));
assign(h, language, NAME_c);
succeed;
}
void
ws_status_timer(Timer tm, Name status)
{ UINT id;
if ( (id = getIdTimer(tm)) )
{ KillTimer(NULL, id);
deleteHashTable(TimerTable, toInt(id));
setIdTimer(tm, 0);
}
if ( status != NAME_idle )
{ long msec = (long) (valReal(tm->interval) * 1000.0);
if ( (id = SetTimer(NULL, 0, (UINT)msec, (TIMERPROC) timer_proc)) )
{ if ( !TimerTable )
{ TimerTable = globalObject(CtoName("active_timers"),
ClassHashTable, EAV);
assign(TimerTable, refer, NAME_none);
}
appendHashTable(TimerTable, toInt(id), tm);
setIdTimer(tm, id);
DEBUG(NAME_timer, Cprintf("Created timer of %d milliseconds (id = %d)\n",
msec, id));
} else
Cprintf("Failed SetTimer()\n");
}
}
int
XPCE_define_classes(const XPCE_class_definition_t *classes)
{ for(; classes->name; classes++)
{ Class class = defineClass(CtoName(classes->name),
CtoName(classes->super),
staticCtoString(classes->summary),
classes->makefunction);
if ( classes->global )
*classes->global = class;
}
numberTreeClass(ClassObject, 0);
succeed;
}
static void
charpToName(Name *n)
{ if ( !n )
return;
*n = CtoName((char *)*n);
}
static void
groupToName(Name *n)
{ if ( !n )
*n = DEFAULT; /* meaning inherit from superclass */
*n = CtoName((char *)*n);
}
static HashTable
LoadX11ColourNames()
{ if ( !X11ColourNames )
{ xcolourdef *cd;
X11ColourNames = globalObject(CtoName("_x11_colour_names"),
ClassHashTable, EAV);
for(cd = x11_colours; cd->name; cd++)
{ COLORREF rgb = RGB(cd->red, cd->green, cd->blue);
appendHashTable(X11ColourNames, toInt(rgb), CtoName(cd->name));
}
}
return X11ColourNames;
}
HashTable
MsObjectTable()
{ static HashTable table;
if ( !table )
table = globalObject(CtoName("ms_objects"), ClassHashTable, EAV);
return table;
}
static Any
get_clipboard_data(DisplayObj d, Name type)
{ HGLOBAL mem;
HENHMETAFILE hmf;
Any rval = FAIL;
OpenClipboard(CLIPBOARDWIN);
if ( type != NAME_winMetafile && (mem = GetClipboardData(CF_UNICODETEXT)) )
{ wchar_t *data = GlobalLock(mem);
wchar_t *copy, *q;
q = copy = pceMalloc((wcslen(data)+1)*sizeof(wchar_t));
for(; *data; data++)
{ if ( *data == '\r' && data[1] == '\n' )
{ data++;
*q++ = '\n';
} else
*q++ = *data;
}
*q = EOS;
rval = WCToString(copy, q-copy);
pceFree(copy);
GlobalUnlock(mem);
} else if ( type != NAME_winMetafile && (mem = GetClipboardData(CF_TEXT)) )
{ char far *data = GlobalLock(mem);
char *copy, *q;
q = copy = pceMalloc(strlen(data));
for(; *data; data++)
{ if ( *data == '\r' && data[1] == '\n' )
{ data++;
*q++ = '\n';
} else
*q++ = *data;
}
*q = EOS;
rval = CtoString(copy);
pceFree(copy);
GlobalUnlock(mem);
} else if ( type != NAME_text && (hmf = GetClipboardData(CF_ENHMETAFILE)) )
{ HENHMETAFILE copy = CopyEnhMetaFile(hmf, NULL);
if ( !copy )
{ errorPce(d, NAME_winMetafile, CtoName("CopyEnhMetaFile"), APIError());
fail;
}
rval = CtoWinMetafile(copy);
DeleteEnhMetaFile(hmf);
}
CloseClipboard();
return rval;
}
static Name
defcolourname(Int r, Int g, Int b)
{ if ( notDefault(r) && notDefault(g) && notDefault(b) )
{ char buf[50];
sprintf(buf, "#%02x%02x%02x",
(unsigned int)valInt(r)>>8,
(unsigned int)valInt(g)>>8,
(unsigned int)valInt(b)>>8);
return CtoName(buf);
}
static HashTable
LoadX11ColourNames()
{ if ( !X11ColourNames )
{ FileObj f = answerObject(ClassFile, CtoName("$PCEHOME/lib/rgb.txt"), EAV);
X11ColourNames = globalObject(CtoName("_x11_colour_names"),
ClassHashTable, EAV);
if ( send(f, NAME_open, NAME_read, EAV) )
{ char line[256];
int r, g, b;
char name[80];
while( fgets(line, sizeof(line), f->fd) )
{ switch( sscanf(line, "%d%d%d%[^\n]", &r, &g, &b, name) )
{ case 4:
{ char *s;
char *e;
COLORREF rgb;
for(s=name; *s && *s <= ' '; s++)
;
for(e = s + strlen(s); e > s && e[-1] <= ' '; e--)
;
*e = EOS;
rgb = RGB(r, g, b);
appendHashTable(X11ColourNames, toInt(rgb), CtoName(s));
break;
}
}
}
send(f, NAME_close, EAV);
}
}
return X11ColourNames;
}
status
ws_system_fonts(DisplayObj d)
{ struct system_font *sf;
for(sf = window_fonts; sf->name; sf++)
{ char buf[256];
sprintf(buf, STOCKFMT, sf->id);
newObject(ClassFont,
NAME_win, CtoKeyword(sf->name), DEFAULT,
CtoName(buf), EAV);
}
succeed;
}
static status
initialiseWinPrinter(WinPrinter prt, Name jobname)
{ if ( isDefault(jobname) )
jobname = CtoName("XPCE");
assign(prt, map_mode, DEFAULT);
assign(prt, device, DEFAULT);
assign(prt, job_name, jobname);
assign(prt, job, NIL);
assign(prt, resolution, DEFAULT);
assign(prt, origin, newObject(ClassPoint, EAV));
prt->ws_ref = alloc(sizeof(ws_printer));
memset(prt->ws_ref, 0, sizeof(ws_printer));
return prependChain(WinPrinters, prt);
}
static HashTable
LoadColourNames()
{ if ( !ColourNames )
{ FileObj f = answerObject(ClassFile, CtoName("$PCEHOME/lib/rgb.txt"), EAV);
ColourNames = globalObject(NAME_colourNames, ClassHashTable, EAV);
if ( send(f, NAME_open, NAME_read, EAV) )
{ char line[256];
int r, g, b;
char name[80];
while( fgets(line, sizeof(line), f->fd) )
{ switch( sscanf(line, "%d%d%d%[^\n]", &r, &g, &b, name) )
{ case 4:
{ char *s;
char *e;
COLORREF rgb;
Name cname;
for(s=name; *s && *s <= ' '; s++)
;
for(e = s + strlen(s); e > s && e[-1] <= ' '; e--)
;
*e = EOS;
for(e=s; *e; e++)
{ if ( isupper(*e) )
*e = tolower(*e);
else if ( *e == ' ' )
*e = '_';
}
cname = CtoKeyword(s);
rgb = RGB(r, g, b);
appendHashTable(ColourNames, cname, toInt(rgb));
DEBUG(NAME_colour, Cprintf("%s --> 0x%lx\n",
pp(cname), (long) rgb));
break;
}
}
}
send(f, NAME_close, EAV);
}
}
return ColourNames;
}
static status
rangeIntItem(IntItem ii, Int low, Int high)
{ char buf[48];
Type t = NULL;
char s1[24], s2[24];
int b = valInt(getClassVariableValueObject(ii, NAME_border));
obtainClassVariablesObject(ii);
if ( isDefault(low) )
{ if ( isDefault(high) )
{ t = TypeInt;
sprintf(s1, INTPTR_FORMAT, PCE_MIN_INT);
sprintf(s2, INTPTR_FORMAT, PCE_MAX_INT);
} else
{ sprintf(s1, INTPTR_FORMAT, PCE_MIN_INT);
sprintf(s2, INTPTR_FORMAT, valInt(high));
sprintf(buf, ".." INTPTR_FORMAT, valInt(high));
}
} else
{ if ( isDefault(high) )
{ sprintf(s1, INTPTR_FORMAT, valInt(low));
sprintf(s2, INTPTR_FORMAT, PCE_MAX_INT);
sprintf(buf, INTPTR_FORMAT "..", valInt(low));
} else
{ sprintf(s1, INTPTR_FORMAT, valInt(low));
sprintf(s2, INTPTR_FORMAT, valInt(high));
sprintf(buf, INTPTR_FORMAT ".." INTPTR_FORMAT,
valInt(low), valInt(high));
}
}
if ( !t )
t = checkType(CtoName(buf), TypeType, NIL);
assign(ii, type, t);
assign(ii, hor_stretch, ZERO);
valueWidthTextItem((TextItem)ii,
toInt(max(width_text(ii->value_font, s1),
width_text(ii->value_font, s2))
+ 2*b + 5 +
+ text_item_combo_width((TextItem)ii)));
succeed;
}
void
ws_open_display(DisplayObj d)
{ d->ws_ref = (WsRef) 1; /* just flag; nothing to do yet */
if ( isDefault(d->colour_map) )
{ if ( ws_has_colourmap(d) )
{ int depth = ws_depth_display(d);
if ( depth == 8 )
{ send(d, NAME_colourMap,
newObject(ClassColourMap, CtoName("colour_cube_216"), EAV), EAV);
}
} else
send(d, NAME_colourMap, NIL, EAV);
}
ws_init_loc_still_timer();
}
Name
SockError()
{
#ifdef NO_WINERR
int err = WSAGetLastError();
wsock_err *e = wsock_err_list;
if ( !err )
return (Name) NIL;
for( ; e->description; e++ )
{ if ( e->id == err )
return CtoName(e->description);
}
return WinStrError(err);
#else
return WinStrError(WSAGetLastError());
#endif
}
static BOOL CALLBACK
next_monitor(HMONITOR m, HDC hdc, LPRECT rect, LPARAM closure)
{ DisplayObj d = (DisplayObj)closure;
MONITORINFOEX info;
Any name;
Monitor mon;
memset(&info, 0, sizeof(info));
info.cbSize = sizeof(info);
if ( GetMonitorInfo(m, (MONITORINFO*)&info) )
{ name = CtoName(info.szDevice);
} else
{ name = d->monitors->size;
}
appendChain(d->monitors,
mon=newObject(ClassMonitor,
name,
newObject(ClassArea,
toInt(rect->left),
toInt(rect->top),
toInt(rect->right - rect->left),
toInt(rect->bottom - rect->top),
EAV),
EAV));
if ( isName(name) )
{ if ( info.dwFlags & MONITORINFOF_PRIMARY )
assign(mon, primary, ON);
assign(mon, work_area,
newObject(ClassArea,
toInt(info.rcWork.left),
toInt(info.rcWork.top),
toInt(info.rcWork.right - info.rcWork.left),
toInt(info.rcWork.bottom - info.rcWork.top),
EAV));
}
return TRUE;
}
void *
pceXtAppContext(void * ctx)
{ if ( ThePceXtAppContext == NULL )
{ if ( ctx != NULL )
{ ThePceXtAppContext = ctx;
XSetErrorHandler(x_error_handler);
} else
{
#if defined(_REENTRANT) && defined(HAVE_XINITTHREADS)
if ( XPCE_mt == TRUE )
{ if ( use_x_init_threads )
XInitThreads();
} else
{ XPCE_mt = -1;
}
#else
XPCE_mt = -1;
#endif
XtToolkitInitialize();
XSetErrorHandler(x_error_handler);
if ( (ThePceXtAppContext = XtCreateApplicationContext()) == NULL )
{ errorPce(TheDisplayManager(), NAME_noApplicationContext);
fail;
}
if ( !XtSetLanguageProc(ThePceXtAppContext, NULL, NULL) )
{ errorPce(TheDisplayManager(), NAME_noLocaleSupport,
CtoName(setlocale(LC_ALL, NULL)));
fail;
}
}
}
return ThePceXtAppContext;
}
status
ws_create_font(FontObj f, DisplayObj d)
{ WsFont wsf = alloc(sizeof(ws_font));
#ifdef __WINDOWS__
int widths[FONTTABLESIZE];
#else
short widths[FONTTABLESIZE];
#endif
HDC hdc;
HFONT old;
int n;
TEXTMETRIC tm;
int stock;
if ( sscanf(strName(f->x_name), STOCKFMT, &stock) == 1 )
{ wsf->hfont = GetStockObject(stock);
wsf->from_stock = TRUE;
} else
{ LOGFONT lfont;
Real scale = getClassVariableValueObject(f, NAME_scale);
float fscale = (scale ? valReal(scale) : 1.4);
memset(&lfont, 0, sizeof(lfont));
lfont.lfHeight = (int)((float) valInt(f->points) * fscale);
lfont.lfWeight = (f->style == NAME_bold ? FW_BOLD : FW_NORMAL);
lfont.lfItalic = ((f->style == NAME_italic ||
f->style == NAME_oblique) ? 1 : 0);
lfont.lfPitchAndFamily = (f->family == NAME_screen ? FIXED_PITCH
: DEFAULT_PITCH);
lfont.lfPitchAndFamily |= (f->family == NAME_helvetica ? FF_SWISS :
f->family == NAME_times ? FF_ROMAN :
f->family == NAME_screen ? FF_MODERN :
FF_DONTCARE);
if ( f->family == NAME_symbol )
strcpy(lfont.lfFaceName, "symbol");
if ( instanceOfObject(f->x_name, ClassCharArray) )
{ strcpy(lfont.lfFaceName, strName(f->family));
parse_font(strName(f->x_name), &lfont);
} else
{ lfont.lfOutPrecision = OUT_TT_ONLY_PRECIS;
lfont.lfQuality = PROOF_QUALITY;
}
if ( !(wsf->hfont = CreateFontIndirect(&lfont)) )
{ Cprintf("Failed to create logical font; replacing with stock font\n");
if ( f->family == NAME_screen )
{ if ( f->style == NAME_bold )
stock = SYSTEM_FIXED_FONT;
else
stock = ANSI_FIXED_FONT;
} else
{ if ( f->style == NAME_bold )
stock = SYSTEM_FONT;
else
stock = ANSI_VAR_FONT;
}
wsf->hfont = GetStockObject(stock);
wsf->from_stock = TRUE;
} else
wsf->from_stock = FALSE;
}
wsf->widths = alloc(FONTTABLESIZE * sizeof(cwidth));
assign(f, iswide, OFF);
hdc = GetDC(NULL);
old = SelectObject(hdc, wsf->hfont);
GetCharWidth(hdc, 0, FONTTABLESIZE-1, widths);
for(n=0; n<FONTTABLESIZE; n++)
wsf->widths[n] = widths[n];
GetTextMetrics(hdc, &tm);
wsf->ascent = tm.tmAscent + tm.tmExternalLeading;
wsf->descent = tm.tmDescent;
/*if ( !(tm.tmPitchAndFamily & TMPF_TRUETYPE) && f->family != NAME_win )
Cprintf("%s (%s/%s): not a TrueType font\n",
pp(f), pp(f->family), pp(f->style));
*/
if ( isDefault(f->x_name) )
{ char buf[256];
if ( GetTextFace(hdc, sizeof(buf), buf) )
assign(f, x_name, CtoName(buf));
}
SelectObject(hdc, old);
ReleaseDC(NULL, hdc);
if ( wsf->widths['i'] == wsf->widths['w'] )
assign(f, fixed_width, ON);
else
assign(f, fixed_width, OFF);
registerXrefObject(f, d, wsf);
succeed;
}
Any
cToPceAssoc(const char *s)
{ return getObjectFromReferencePce(PCE, CtoName(s));
}
static void
breakGoal(PceGoal g)
{ char buf[LINESIZE];
char *s;
start:
writef(" ? ");
Cflush();
s = Cgetline(buf, sizeof(buf));
if ( s )
{ int argc = 0;
char *argv[100];
char *q;
Int numarg = DEFAULT;
for(q = s; *q; )
{ while(*q && isspace(*q))
q++;
if ( *q == EOS )
break;
argv[argc++] = q;
while(*q && !isspace(*q))
q++;
if ( *q != EOS )
*q++ = EOS;
}
if ( argc >= 2 && isdigit(argv[1][0]) )
numarg = toInt(atoi(argv[1]));
if ( argc == 0 )
return;
switch(argv[0][0])
{ case 'g':
ServiceMode(PCE_EXEC_SERVICE,
if ( argv[0][1] == 'h' )
hostAction(HOST_BACKTRACE,
isDefault(numarg) ? 5 : valInt(numarg));
else
pceBackTrace(g, isDefault(numarg) ? 5 : valInt(numarg)));
goto again;
case 'b':
if ( !hostAction(HOST_BREAK) )
send(HostObject(), NAME_break, EAV);
goto again;
case 'a':
if ( !hostAction(HOST_ABORT) )
send(HostObject(), NAME_abort, EAV);
goto again; /* should not happen */
case 'e':
{ Error e;
if ( argc == 2 )
{ if ( !(e = getConvertError(ClassError, CtoName(argv[1]))) )
{ writef("No such error: %s\n", CtoName(argv[1]));
goto again;
}
} else
{ if ( !(e = getConvertError(ClassError, PCE->last_error)) )
{ writef("No current error\n");
goto again;
}
}
if ( !e )
{ writef("No current error\n");
goto again;
}
switch(argv[0][1])
{ case 'i':
assign(e, kind, NAME_ignored);
break;
case 'e':
assign(e, kind, NAME_error);
break;
case 'f':
assign(e, kind, NAME_fatal);
break;
default:
case 'w':
assign(e, kind, NAME_warning);
break;
}
writef("Switched error \"%s\" to ->kind \"%s\"\n",
e->id, e->kind);
goto again;
}
case 'q':
debuggingPce(PCE, OFF);
send(PCE, NAME_die, EAV);
exit(1); /* should not happen */
case 'c':
case EOS:
return;
case '?':
case 'h':
actionHelp();
goto again;
default:
writef("Unknown option. (? for help)\n");
goto again;
}
} else
{ hostAction(HOST_HALT);
Name
ws_window_manager(DisplayObj d)
{ answer(CtoName("windows"));
}
void
initClassDefs()
{ defineClasses(classdefs);
#define defClass(n, s, mf, cp, summ) \
(cp) = defineClass(n, s, CtoString(summ), mf);
defClass(CtoName("*"), NAME_binaryExpression, makeClassTimes,
ClassTimes, "Multiplication expression");
defClass(CtoName("-"), NAME_binaryExpression, makeClassMinus,
ClassMinus, "Subtraction expression");
defClass(CtoName("+"), NAME_binaryExpression, makeClassPlus,
ClassPlus, "Addition expression");
defClass(CtoName("/"), NAME_binaryExpression, makeClassDivide,
ClassDivide, "Division expression");
defClass(CtoName(":="), NAME_object, makeClassBinding,
ClassBinding, "Name-value pair for argument-list");
defClass(CtoName("<"), NAME_binaryCondition, makeClassLess,
ClassLess, "Compare expressions on less-then");
defClass(CtoName("="), NAME_binaryCondition, makeClassEquation,
ClassEquation, "Identity between two expressions");
defClass(CtoName("=<"), NAME_binaryCondition, makeClassLessEqual,
ClassLessEqual, "Compare expressions on less-or-equal");
defClass(CtoName("=="), NAME_code, makeClassEqual,
ClassEqual, "Test equivalence of arguments");
defClass(CtoName(">"), NAME_binaryCondition, makeClassGreater,
ClassGreater, "Test equivalence of arguments");
defClass(CtoName(">="), NAME_binaryCondition, makeClassGreaterEqual,
ClassGreaterEqual, "Compare expressions on greater-or-equal");
defClass(CtoName("?"), NAME_function, makeClassObtain,
ClassObtain, "Invoke a get method");
defClass(CtoName("\\=="), NAME_code, makeClassNonEqual,
ClassNonEqual, "Test non-equivalence of arguments");
defClass(CtoName("@="), NAME_code, makeClassAssoc,
ClassAssoc, "Assign named reference to object");
initBoxes();
numberTreeClass(ClassObject, 0);
}
Atom
WmProtocols(FrameObj fr)
{ return FrameAtom(fr, CtoName("WM_PROTOCOLS"));
}
