/*-------------------------------------------------------------------------*/
void Init_Atom_Pred(void)
{
atom_tbl=Hash_Table(MAX_ATOM_TBL_SIZE,sizeof(AtomInf),0);
if (atom_tbl==NULL)
Fatal_Error(ERR_ALLOC_FAULT);
atom_nil =Create_Atom("[]");
atom_dot =Create_Atom(".");
atom_curly_brackets=Create_Atom("{}");
atom_fail =Create_Atom("fail");
atom_g_array =Create_Atom("g_array");
atom_g_array_extend=Create_Atom("g_array_extend");
atom_inf =Create_Atom("<");
atom_eq =Create_Atom("=");
atom_sup =Create_Atom(">");
atom_compiler =Create_Atom(COMPILER);
atom_wam_version =Create_Atom(WAM_VERSION);
pred_tbl=Hash_Table(MAX_PRED_TBL_SIZE,sizeof(PredInf),sizeof(int));
if (pred_tbl==NULL)
Fatal_Error(ERR_ALLOC_FAULT);
oper_tbl=Hash_Table(MAX_OPER_TBL_SIZE,sizeof(OperInf),sizeof(int));
if (oper_tbl==NULL)
Fatal_Error(ERR_ALLOC_FAULT);
consult_count=0;
}
char *Find_Executable (char *fn) {
char *path, *dir, *getenv();
static char buf[1025]; /* Can't use Path_Max or Safe_Malloc here */
register char *p;
for (p = fn; *p; p++) {
if (*p == '/') {
if (Executable (fn))
return fn;
else
Fatal_Error ("%s is not executable", fn);
}
}
if ((path = getenv ("PATH")) == 0)
path = ":/usr/ucb:/bin:/usr/bin";
dir = path;
do {
p = buf;
while (*dir && *dir != ':')
*p++ = *dir++;
if (*dir)
++dir;
if (p > buf)
*p++ = '/';
strcpy (p, fn);
if (Executable (buf))
return buf;
} while (*dir);
if (dir > path && dir[-1] == ':' && Executable (fn))
return fn;
Fatal_Error ("cannot find pathname of %s", fn);
/*NOTREACHED*/
}
/*-------------------------------------------------------------------------*/
PredInf *Create_Pred(AtomInf *functor,int arity,int module_nb,CodePtr codep)
{
PredTbl tbl=(module_nb==0) ? pred_tbl : module_tbl[module_nb].pred_tbl;
PredInf pred_info;
PredInf *pred;
pred_info.f_n =Make_Pred_Key(functor,arity);
pred_info.owner_mod_nb=module_nb;
pred_info.codep =codep;
if (codep)
pred_info.dynamic=NULL;
else
{
if ((pred_info.dynamic=(DynPInf *) Lib1(malloc,sizeof(DynPInf)))==NULL)
Fatal_Error(ERR_ALLOC_FAULT);
Init_Dynamic_Info(pred_info.dynamic);
}
pred=(PredInf *) Hash_Lookup(tbl,(char *) &pred_info,H_UPDATE);
if ((int) pred == -1)
Fatal_Error(ERR_PRED_TBL_FULL);
return pred;
}
/*
* Select_Window_Args: a rountine to provide a common interface for
* applications that need to allow the user to select one
* window on the screen for special consideration.
* This routine implements the following command line
* arguments:
*
* -root Selects the root window.
* -id <id> Selects window with id <id>. <id> may
* be either in decimal or hex.
* -name <name> Selects the window with name <name>.
*
* Call as Select_Window_Args(&argc, argv) in main before
* parsing any of your program's command line arguments.
* Select_Window_Args will remove its arguments so that
* your program does not have to worry about them.
* The window returned is the window selected or 0 if
* none of the above arguments was present. If 0 is
* returned, Select_Window should probably be called after
* all command line arguments, and other setup is done.
* For examples of usage, see xwininfo, xwd, or xprop.
*/
Window Select_Window_Args(
int *rargc,
char **argv)
#define ARGC (*rargc)
{
int nargc=1;
int argc;
char **nargv;
Window w=0;
nargv = argv+1; argc = ARGC;
#define OPTION argv[0]
#define NXTOPTP ++argv, --argc>0
#define NXTOPT if (++argv, --argc==0) usage()
#define COPYOPT nargv++[0]=OPTION, nargc++
while (NXTOPTP) {
if (!strcmp(OPTION, "-")) {
COPYOPT;
while (NXTOPTP)
COPYOPT;
break;
}
if (!strcmp(OPTION, "-root")) {
w=RootWindow(dpy, screen);
continue;
}
if (!strcmp(OPTION, "-name")) {
NXTOPT;
w = Window_With_Name(dpy, RootWindow(dpy, screen),
OPTION);
if (!w)
Fatal_Error("No window with name %s exists!",OPTION);
continue;
}
if (!strcmp(OPTION, "-id")) {
NXTOPT;
w=0;
sscanf(OPTION, "0x%lx", &w);
if (!w)
sscanf(OPTION, "%lu", &w);
if (!w)
Fatal_Error("Invalid window id format: %s.", OPTION);
continue;
}
COPYOPT;
}
ARGC = nargc;
return(w);
}
/*
* Realloc: like realloc but handles out of memory using Fatal_Error:
*/
char *Realloc(char *mem, unsigned size)
{
if (!(mem = realloc (mem, size)))
Fatal_Error("Out of memory!");
return mem;
}
int Define_Type (register int t, char const *name,
int (*size)(), int const_size, int (*eqv)(), int (*equal)(),
int (*print)(), int (*visit)()) {
register TYPEDESCR *p;
Set_Error_Tag ("define-type");
if (t != 0)
Fatal_Error("first arg of Define_Type() must be 0");
if (Num_Types == Max_Type) {
Max_Type += TYPE_GROW;
Types = (TYPEDESCR *)Safe_Realloc((char *)Types,
Max_Type * sizeof(TYPEDESCR));
}
Disable_Interrupts;
p = &Types[Num_Types++];
p->haspointer = 1;
p->name = name;
p->size = size;
p->const_size = const_size;
p->eqv = eqv;
p->equal = equal;
p->print = print;
p->visit = visit;
Enable_Interrupts;
return Num_Types-1;
}
/*
* Malloc: like malloc but handles out of memory using Fatal_Error.
*/
char *Malloc(unsigned size)
{
char *data;
if (!(data = malloc(size)))
Fatal_Error("Out of memory!");
return(data);
}
/*
* Open_Font: This routine opens a font with error handling.
*/
XFontStruct *Open_Font(const char *name)
{
XFontStruct *font;
if (!(font=XLoadQueryFont(dpy, name)))
Fatal_Error("Unable to open font %s!", name);
return(font);
}
void Make_Heap (int size) {
register unsigned int k = 1024 * size;
register unsigned int s = 2 * k;
if ((Hp = Heap_Start = (char *)sbrk (s)) == (char *)-1)
Fatal_Error ("cannot allocate heap (%u KBytes)", 2*size);
Heap_End = Heap_Start + k;
Free_Start = Heap_End;
Free_End = Free_Start + k;
}
/*-------------------------------------------------------------------------*/
SwtTbl Create_Swt_Table(int size)
{
SwtTbl t;
if ((t=Hash_Table(size+8,sizeof(SwtInf),sizeof(int)))==NULL)
Fatal_Error(ERR_ALLOC_FAULT);
return t;
}
Object P_Collect () {
register char *tmp;
register int msg = 0;
Object a[2];
if (!Interpreter_Initialized)
Fatal_Error ("heap too small (increase heap size)");
if (GC_In_Progress)
Fatal_Error ("GC while GC in progress");
Disable_Interrupts;
GC_In_Progress = 1;
Call_Before_GC ();
if (GC_Debug) {
printf ("."); (void)fflush (stdout);
} else if (Var_Is_True (V_Garbage_Collect_Notifyp)) {
msg++;
Format (Standard_Output_Port, "[Garbage collecting... ", 23, 0,
(Object *)0);
(void)fflush (stdout);
}
To = Free_Start;
Visit_GC_List (Global_GC_Obj, 0);
Visit_GC_List (GC_List, 0);
Visit_Wind (First_Wind, 0);
Hp = To;
tmp = Heap_Start; Heap_Start = Free_Start; Free_Start = tmp;
tmp = Heap_End; Heap_End = Free_End; Free_End = tmp;
if (!GC_Debug) {
if (msg) {
a[0] = Make_Integer ((Hp-Heap_Start) / 1024);
a[1] = Make_Integer ((Heap_End-Heap_Start) / 1024);
Format (Standard_Output_Port, "~sK of ~sK]~%", 13, 2, a);
}
}
Call_After_GC ();
GC_In_Progress = 0;
Enable_Interrupts;
return Void;
}
char *Safe_Realloc (char *ptr, unsigned int size) {
char *ret;
Disable_Interrupts;
if ((ret = ptr ? realloc (ptr, size) : malloc (size)) == 0) {
if (Interpreter_Initialized)
Primitive_Error ("not enough memory to malloc ~s bytes",
Make_Integer (size));
else
Fatal_Error ("not enough memory to malloc %u bytes", size);
}
Enable_Interrupts;
return ret;
}
/*-------------------------------------------------------------------------*/
PredTbl Create_Pred_Table(int size)
{
PredTbl tbl;
if (size==0)
return NULL;
tbl=Hash_Table(size,sizeof(PredInf),sizeof(int));
if (tbl==NULL)
Fatal_Error(ERR_ALLOC_FAULT);
return tbl;
}
Window Select_Window(Display *disp, int descend)
{
int status;
Cursor cursor;
XEvent event;
Window target_win = None, root = RootWindow(disp,screen);
int buttons = 0;
/* Make the target cursor */
cursor = XCreateFontCursor(disp, XC_crosshair);
/* Grab the pointer using target cursor, letting it room all over */
status = XGrabPointer(disp, root, False,
ButtonPressMask|ButtonReleaseMask, GrabModeSync,
GrabModeAsync, root, cursor, CurrentTime);
if (status != GrabSuccess) Fatal_Error("Can't grab the mouse.");
/* Let the user select a window... */
while ((target_win == None) || (buttons != 0)) {
/* allow one more event */
XAllowEvents(disp, SyncPointer, CurrentTime);
XWindowEvent(disp, root, ButtonPressMask|ButtonReleaseMask, &event);
switch (event.type) {
case ButtonPress:
if (target_win == None) {
target_win = event.xbutton.subwindow; /* window selected */
if (target_win == None) target_win = root;
}
buttons++;
break;
case ButtonRelease:
if (buttons > 0) /* there may have been some down before we started */
buttons--;
break;
}
}
XUngrabPointer(disp, CurrentTime); /* Done with pointer */
if (!descend || (target_win == root))
return(target_win);
target_win = Find_Client(disp, root, target_win);
return(target_win);
}
/*-------------------------------------------------------------------------*/
OperInf *Create_Oper(AtomInf *atom,int type,int prec,int left,int right)
{
OperInf oper_info;
OperInf *oper;
oper_info.a_t =Make_Oper_Key(atom,type);
oper_info.prec =prec;
oper_info.left =left;
oper_info.right=right;
oper=(OperInf *) Hash_Lookup(oper_tbl,(char *) &oper_info,H_UPDATE);
if ((int) oper == -1)
Fatal_Error(ERR_OPER_TBL_FULL);
return oper;
}
/*
* Setup_Display_And_Screen: This routine opens up the correct display (i.e.,
* it calls Get_Display_Name) and then stores a
* pointer to it in dpy. The default screen
* for this display is then stored in screen.
*/
void Setup_Display_And_Screen (
const char *display_name,
xcb_connection_t **dpy, /* MODIFIED */
xcb_screen_t **screen) /* MODIFIED */
{
int screen_number, i;
/* Open Display */
*dpy = xcb_connect (display_name, &screen_number);
if (xcb_connection_has_error (*dpy)) {
Fatal_Error ("unable to open display \"%s\"",
Get_Display_Name(display_name) );
}
if (screen) {
/* find our screen */
const xcb_setup_t *setup = xcb_get_setup(*dpy);
xcb_screen_iterator_t screen_iter = xcb_setup_roots_iterator(setup);
for (i = 0; i < screen_number; i++)
xcb_screen_next(&screen_iter);
*screen = screen_iter.data;
}
}
//#####################################################################
// Function Fatal_Error
//#####################################################################
void Fatal_Error(const char* function,const char* file,unsigned int line)
{
Fatal_Error(function,file,line,"Fatal error");
}
void Memgr_Fault_Handler(Caller,Primary_CC,Sec_CC)
{
Signal(Primary_CC);
Fatal_Error("Memory Mgmt. Fault detected.",Primary_CC);
}
void Elk_Init (int ac, char **av, int init_objects, char *toplevel) {
/* To avoid that the stack copying code overwrites argv if a dumped
* copy of the interpreter is invoked with more arguments than the
* original a.out, move the stack base INITIAL_STK_OFFSET bytes down.
* The call to memset() is there to prevent the optimizer from removing
* the array.
*/
#ifdef CAN_DUMP
char unused[INITIAL_STK_OFFSET];
#endif
char *initfile, *loadfile = 0, *loadpath = 0;
int debug = 0, heap = HEAP_SIZE;
Object file;
struct stat st;
extern int errno;
#if defined(CAN_DUMP)
# define foo (av[0][0])
#else
volatile char foo;
#endif
#ifdef CAN_DUMP
memset (unused, 0, 1); /* see comment above */
#endif
if (ac == 0) {
av[0] = "Elk"; ac = 1;
}
Get_Stack_Limit ();
Lib_Dir = NULL;
Scm_Dir = NULL;
#ifdef WIN32
if (av[0]) {
char path[MAX_PATH], *exe;
GetFullPathName (av[0], MAX_PATH, path, &exe);
if (exe > path && exe[-1] == '\\') {
char newpath[MAX_PATH+5];
exe[-1] = '\0';
sprintf (newpath, "%s\\lib", path);
Lib_Dir = strdup (newpath);
sprintf (newpath, "%s\\scm", path);
Scm_Dir = strdup (newpath);
}
}
#elif defined(FIND_AOUT)
A_Out_Name = Find_Executable (av[0]);
#endif
if (Scm_Dir == NULL)
Scm_Dir = strdup (SCM_DIR);
if (Lib_Dir == NULL)
Lib_Dir = strdup (LIB_DIR);
Argc = ac; Argv = av;
First_Arg = 1;
#ifdef CAN_DUMP
if (Was_Dumped) {
/* Check if beginning of stack has moved by a large amount.
* This is the case, for instance, on a Sun-4m when the
* interpreter was dumped on a Sun-4c and vice versa.
*/
if (abs (stkbase - &foo) > INITIAL_STK_OFFSET) {
fprintf (stderr,
"Can't restart dumped interpreter from a different machine architecture\n");
fprintf (stderr,
" (Stack delta = %lld bytes).\n", (long long int)(intptr_t)(stkbase - &foo));
exit (1);
}
/* Check if program break must be reset.
*/
if ((intptr_t)Brk_On_Dump && (intptr_t)brk (Brk_On_Dump)
== (intptr_t)-1) {
perror ("brk"); exit (1);
}
#if defined(HP9K) && defined(CAN_DUMP) && defined(HPSHLIB)
Restore_Shared_Data ();
#endif
#ifdef GENERATIONAL_GC
Generational_GC_Reinitialize ();
#endif
Loader_Input = 0;
Install_Intr_Handler ();
(void)Funcall_Control_Point (Dump_Control_Point, Arg_True, 0);
/*NOTREACHED*/
}
#endif
for ( ; First_Arg < ac; First_Arg++) {
if (strcmp (av[First_Arg], "-debug") == 0) {
debug = 1;
} else if (strcmp (av[First_Arg], "-g") == 0) {
Case_Insensitive = 0;
} else if (strcmp (av[First_Arg], "-i") == 0) {
Case_Insensitive = 1;
} else if (strcmp (av[First_Arg], "-v") == 0) {
if (++First_Arg == ac)
Usage ();
if (strcmp (av[First_Arg], "load") == 0)
Verb_Load = 1;
else if (strcmp (av[First_Arg], "init") == 0)
Verb_Init = 1;
else Usage ();
} else if (strcmp (av[First_Arg], "-h") == 0) {
if (++First_Arg == ac)
Usage ();
if ((heap = atoi (av[First_Arg])) <= 0) {
fprintf (stderr, "Heap size must be a positive number.\n");
exit (1);
}
} else if (strcmp (av[First_Arg], "-l") == 0) {
if (++First_Arg == ac || loadfile)
Usage ();
loadfile = av[First_Arg];
} else if (strcmp (av[First_Arg], "-p") == 0) {
if (++First_Arg == ac || loadpath)
Usage ();
loadpath = av[First_Arg];
} else if (strcmp (av[First_Arg], "--") == 0) {
First_Arg++;
break;
} else if (av[First_Arg][0] == '-') {
Usage ();
} else {
break;
}
}
stkbase = &foo;
Stack_Grows_Down = Check_Stack_Grows_Down ();
ELK_ALIGN(stkbase);
Make_Heap (heap);
Init_Everything ();
#ifdef HAVE_ATEXIT
if (atexit (Exit_Handler) != 0)
Fatal_Error ("atexit returned non-zero value");
#endif
#ifdef INIT_OBJECTS
if (init_objects) {
Set_Error_Tag ("init-objects");
The_Symbols = Open_File_And_Snarf_Symbols (A_Out_Name);
Call_Initializers (The_Symbols, (char *)0, PR_EXTENSION);
}
#endif
if (loadpath || (loadpath = getenv (LOADPATH_ENV)))
Init_Loadpath (loadpath);
/* The following code is sort of a hack. initscheme.scm should not
* be resolved against load-path. However, the .scm-files may not
* have been installed yet (note that the interpreter is already
* used in the "make" process).
* Solution: if initscheme.scm hasn't been installed yet, do search
* the load-path, so that -p can be used.
*/
Set_Error_Tag ("scheme-init");
initfile = Safe_Malloc (strlen (Scm_Dir) + 1 + sizeof (INITFILE) + 1);
sprintf (initfile, "%s" SEPARATOR_STRING "%s", Scm_Dir, INITFILE);
if (stat (initfile, &st) == -1 && errno == ENOENT)
file = Make_String (INITFILE, sizeof(INITFILE)-1);
else
file = Make_String (initfile, strlen (initfile));
free (initfile);
(void)General_Load (file, The_Environment);
Install_Intr_Handler ();
Set_Error_Tag ("top-level");
if (toplevel == 0) {
Interpreter_Initialized = 1;
GC_Debug = debug;
return;
}
/* Special case: if toplevel is "", act as if run from main() */
if (loadfile == 0 && toplevel[0] != '\0')
loadfile = toplevel;
if (loadfile == 0)
loadfile = "toplevel.scm";
file = Make_String (loadfile, strlen (loadfile));
Interpreter_Initialized = 1;
GC_Debug = debug;
if (loadfile[0] == '-' && loadfile[1] == '\0')
Load_Source_Port (Standard_Input_Port);
else
(void)General_Load (file, The_Environment);
}
static xcb_window_t
recursive_Window_With_Name (
xcb_connection_t *dpy,
xcb_window_t window,
struct wininfo_cookies *cookies,
const char *name)
{
xcb_window_t *children;
unsigned int nchildren;
int i;
xcb_window_t w = 0;
xcb_generic_error_t *err;
xcb_query_tree_reply_t *tree;
struct wininfo_cookies *child_cookies;
xcb_get_property_reply_t *prop;
if (cookies->get_net_wm_name.sequence) {
prop = xcb_get_property_reply (dpy, cookies->get_net_wm_name, &err);
if (prop) {
if (prop->type == atom_utf8_string) {
const char *prop_name = xcb_get_property_value (prop);
int prop_name_len = xcb_get_property_value_length (prop);
/* can't use strcmp, since prop.name is not null terminated */
if (strncmp (prop_name, name, prop_name_len) == 0) {
w = window;
}
}
free (prop);
} else if (err) {
if (err->response_type == 0)
Print_X_Error (dpy, err);
return 0;
}
}
if (w) {
xcb_discard_reply (dpy, cookies->get_wm_name.sequence);
} else {
#ifdef USE_XCB_ICCCM
xcb_get_text_property_reply_t nameprop;
if (xcb_get_wm_name_reply (dpy, cookies->get_wm_name,
&nameprop, &err)) {
/* can't use strcmp, since nameprop.name is not null terminated */
if (strncmp (nameprop.name, name, nameprop.name_len) == 0) {
w = window;
}
xcb_get_text_property_reply_wipe (&nameprop);
}
#else
prop = xcb_get_property_reply (dpy, cookies->get_wm_name, &err);
if (prop) {
if (prop->type == XCB_ATOM_STRING) {
const char *prop_name = xcb_get_property_value (prop);
int prop_name_len = xcb_get_property_value_length (prop);
/* can't use strcmp, since prop.name is not null terminated */
if (strncmp (prop_name, name, prop_name_len) == 0) {
w = window;
}
}
free (prop);
}
#endif
else if (err) {
if (err->response_type == 0)
Print_X_Error (dpy, err);
return 0;
}
}
if (w)
{
xcb_discard_reply (dpy, cookies->query_tree.sequence);
return w;
}
tree = xcb_query_tree_reply (dpy, cookies->query_tree, &err);
if (!tree) {
if (err->response_type == 0)
Print_X_Error (dpy, err);
return 0;
}
nchildren = xcb_query_tree_children_length (tree);
children = xcb_query_tree_children (tree);
child_cookies = calloc(nchildren, sizeof(struct wininfo_cookies));
if (child_cookies == NULL)
Fatal_Error("Failed to allocate memory in recursive_Window_With_Name");
for (i = 0; i < nchildren; i++) {
if (atom_net_wm_name && atom_utf8_string)
child_cookies[i].get_net_wm_name =
xcb_get_net_wm_name (dpy, children[i]);
child_cookies[i].get_wm_name = xcb_get_wm_name (dpy, children[i]);
child_cookies[i].query_tree = xcb_query_tree (dpy, children[i]);
}
xcb_flush (dpy);
for (i = 0; i < nchildren; i++) {
w = recursive_Window_With_Name (dpy, children[i],
&child_cookies[i], name);
if (w)
break;
}
if (w)
{
/* clean up remaining replies */
for (/* keep previous i */; i < nchildren; i++) {
if (child_cookies[i].get_net_wm_name.sequence)
xcb_discard_reply (dpy,
child_cookies[i].get_net_wm_name.sequence);
xcb_discard_reply (dpy, child_cookies[i].get_wm_name.sequence);
xcb_discard_reply (dpy, child_cookies[i].query_tree.sequence);
}
}
free (child_cookies);
free (tree); /* includes storage for children[] */
return (w);
}
xcb_window_t Select_Window(xcb_connection_t *dpy,
const xcb_screen_t *screen,
int descend)
{
xcb_cursor_t cursor;
xcb_generic_event_t *event;
xcb_window_t target_win = XCB_WINDOW_NONE;
xcb_window_t root = screen->root;
int buttons = 0;
xcb_generic_error_t *err;
xcb_grab_pointer_cookie_t grab_cookie;
xcb_grab_pointer_reply_t *grab_reply;
/* Make the target cursor */
cursor = Create_Font_Cursor (dpy, XC_crosshair);
/* Grab the pointer using target cursor, letting it room all over */
grab_cookie = xcb_grab_pointer
(dpy, False, root,
XCB_EVENT_MASK_BUTTON_PRESS | XCB_EVENT_MASK_BUTTON_RELEASE,
XCB_GRAB_MODE_SYNC, XCB_GRAB_MODE_ASYNC,
root, cursor, XCB_TIME_CURRENT_TIME);
grab_reply = xcb_grab_pointer_reply (dpy, grab_cookie, &err);
if (grab_reply->status != XCB_GRAB_STATUS_SUCCESS)
Fatal_Error ("Can't grab the mouse.");
/* Let the user select a window... */
while ((target_win == XCB_WINDOW_NONE) || (buttons != 0)) {
/* allow one more event */
xcb_allow_events (dpy, XCB_ALLOW_SYNC_POINTER, XCB_TIME_CURRENT_TIME);
xcb_flush (dpy);
event = xcb_wait_for_event (dpy);
switch (event->response_type & 0x7f) {
case XCB_BUTTON_PRESS:
{
xcb_button_press_event_t *bp = (xcb_button_press_event_t *)event;
if (target_win == XCB_WINDOW_NONE) {
target_win = bp->child; /* window selected */
if (target_win == XCB_WINDOW_NONE)
target_win = root;
}
buttons++;
break;
}
case XCB_BUTTON_RELEASE:
if (buttons > 0) /* there may have been some down before we started */
buttons--;
break;
default:
/* just discard all other events */
break;
}
free (event);
}
xcb_ungrab_pointer (dpy, XCB_TIME_CURRENT_TIME); /* Done with pointer */
if (!descend || (target_win == root))
return (target_win);
target_win = Find_Client (dpy, root, target_win);
return (target_win);
}
static
void show_fonts(void)
{
int i;
if (font_cnt == 0)
return;
/* first sort the output */
if (sort_output) qsort(font_list, font_cnt, sizeof(FontList), compare);
if (long_list > L_MEDIUM) {
for (i = 0; i < font_cnt; i++) {
do_query_font (dpy, font_list[i].name);
}
return;
}
if (long_list == L_MEDIUM) {
XFontStruct *pfi;
char *string;
printf("DIR ");
printf("MIN ");
printf("MAX ");
printf("EXIST ");
printf("DFLT ");
printf("PROP ");
printf("ASC ");
printf("DESC ");
printf("NAME");
printf("\n");
for (i=0; i<font_cnt; i++) {
pfi = font_list[i].info;
if (!pfi) {
fprintf(stderr, "%s: no font information for font \"%s\".\n",
program_name,
font_list[i].name ?
font_list[i].name : "");
continue;
}
switch(pfi->direction) {
case FontLeftToRight: string = "-->"; break;
case FontRightToLeft: string = "<--"; break;
default: string = "???"; break;
}
printf("%-4s", string);
if (pfi->min_byte1 == 0 &&
pfi->max_byte1 == 0) {
printf(" %3d ", pfi->min_char_or_byte2);
printf(" %3d ", pfi->max_char_or_byte2);
} else {
printf("*%3d ", pfi->min_byte1);
printf("*%3d ", pfi->max_byte1);
}
printf("%5s ", pfi->all_chars_exist ? "all" : "some");
printf("%4d ", pfi->default_char);
printf("%4d ", pfi->n_properties);
printf("%3d ", pfi->ascent);
printf("%4d ", pfi->descent);
printf("%s\n", font_list[i].name);
if (min_max) {
char min[ BUFSIZ ],
max[ BUFSIZ ];
char *pmax = max,
*pmin = min;
strcpy(pmin, " min(l,r,w,a,d) = (");
strcpy(pmax, " max(l,r,w,a,d) = (");
pmin += strlen(pmin);
pmax += strlen(pmax);
copy_number(&pmin, &pmax,
pfi->min_bounds.lbearing,
pfi->max_bounds.lbearing);
*pmin++ = *pmax++ = ',';
copy_number(&pmin, &pmax,
pfi->min_bounds.rbearing,
pfi->max_bounds.rbearing);
*pmin++ = *pmax++ = ',';
copy_number(&pmin, &pmax,
pfi->min_bounds.width,
pfi->max_bounds.width);
*pmin++ = *pmax++ = ',';
copy_number(&pmin, &pmax,
pfi->min_bounds.ascent,
pfi->max_bounds.ascent);
*pmin++ = *pmax++ = ',';
copy_number(&pmin, &pmax,
pfi->min_bounds.descent,
pfi->max_bounds.descent);
*pmin++ = *pmax++ = ')';
*pmin = *pmax = '\0';
printf("%s\n", min);
printf("%s\n", max);
}
}
return;
}
if ((columns == 0 && isatty(1)) || columns > 1) {
int width,
max_width = 0,
lines_per_column,
j,
index;
for (i=0; i<font_cnt; i++) {
width = strlen(font_list[i].name);
if (width > max_width)
max_width = width;
}
if (max_width == 0)
Fatal_Error("all %d fontnames listed are zero length", font_cnt);
if (columns == 0) {
if ((max_width * 2) + output_line_padding >
max_output_line_width) {
columns = 1;
} else {
max_width += output_line_padding;
columns = ((max_output_line_width +
output_line_padding) / max_width);
}
} else {
max_width += output_line_padding;
}
if (columns <= 1) goto single_column;
if (font_cnt < columns)
columns = font_cnt;
lines_per_column = (font_cnt + columns - 1) / columns;
for (i=0; i<lines_per_column; i++) {
for (j=0; j<columns; j++) {
index = j * lines_per_column + i;
if (index >= font_cnt)
break;
if (j+1 == columns)
printf("%s", font_list[ index ].name);
else
printf("%-*s",
max_width,
font_list[ index ].name);
}
printf("\n");
}
return;
}
single_column:
for (i=0; i<font_cnt; i++)
printf("%s\n", font_list[i].name);
}
/*-------------------------------------------------------------------------*/
static Bool G_Assign_Element(GVarElt *g_elem,WamWord gval_word,
Bool backtrack,Bool copy)
{
WamWord word,tag,*adr;
AtomInf *atom;
int size;
int size_base=0;
GVarElt save_g_elem;
save_g_elem=*g_elem;
Deref(gval_word,word,tag,adr)
if (tag==STC)
{
adr=UnTag_STC(word);
atom=Functor(adr);
if (atom==atom_g_array || atom==atom_g_array_extend) /* an array */
{
if (!G_Assign_Array(g_elem,adr,atom==atom_g_array_extend,copy))
return FALSE;
goto finish;
}
}
if (!copy || tag==CST || tag==INT) /* a link */
{
if (tag==REF && Is_A_Local_Adr(adr))
{
word=Tag_Value(REF,H);
Globalize_Local_Unbound_Var(adr);
}
g_elem->size=0;
g_elem->val=Global_UnMove(tag) ? Tag_Value(REF,adr) : word;
goto finish;
}
/* a copy */
size=Term_Size(word);
if ((adr=(WamWord *) Lib1(malloc,size*sizeof(WamWord)))==NULL)
Fatal_Error(ERR_ALLOC_FAULT);
g_elem->size=size+size_base;
g_elem->val=(WamWord) adr;
Copy_Term(adr,&word);
finish:
if (backtrack)
{
Trail_Push(save_g_elem.val); /* push frame (see G_Untrail) */
Trail_Push(save_g_elem.size);
Trail_Push(g_elem);
Trail_FC(G_Untrail)
}
else
/*-------------------------------------------------------------------------*/
AtomInf *Create_Atom(char *name)
{
AtomInf atom_info;
AtomInf *atom;
char *p;
int c_type;
int lg;
Bool indentifier;
Bool symbols;
if (atom=(AtomInf *) Hash_Lookup(atom_tbl,(char *) (&name),H_FIND))
return atom; /* already exists */
atom_info.name =name;
atom_info.has_quote =FALSE;
indentifier=(*name && char_type[*name]==SL); /* small letter */
symbols =(*name);
for(lg=0,p=name;*p;p++)
{
c_type=char_type[*p];
if ((c_type & (UL | CL | SL | DI))==0)
indentifier=FALSE;
if (c_type!=SY)
symbols=FALSE;
if (c_type==QT)
atom_info.has_quote=TRUE;
}
lg=p-name;
if (indentifier)
{
atom_info.type=IDENTIFIER_ATOM;
atom_info.needs_quote=FALSE;
}
else
if (symbols)
{
atom_info.type=SYMBOL_ATOM;
atom_info.needs_quote=(lg==1 && *name=='.');
}
else
if (lg==1 && char_type[*name]==SC)
{
atom_info.type=SOLO_ATOM;
atom_info.needs_quote=FALSE;
}
else
{
atom_info.type=OTHER_ATOM;
atom_info.needs_quote=! (lg==2 &&
(name[0]=='[' && name[1]==']' ||
name[0]=='{' && name[1]=='}') );
}
atom_info.length=lg;
atom_info.g_elem.size=0;
atom_info.g_elem.val =G_VAR_INITIAL_VALUE;
atom=(AtomInf *) Hash_Lookup(atom_tbl,(char *) &atom_info,H_UPDATE);
if ((int) atom == -1)
Fatal_Error(ERR_ATOM_TBL_FULL);
return atom;
}
void Fatal_Error(const char* function,const char* file,unsigned int line,const char* message)
{
Fatal_Error(function,file,line,std::string(message));
}
