static LISP x_get_cell(LISP row, LISP col, LISP bname)
{
int r, c;
char *p;
buffer *buf;
int s;
r = get_c_long(row);
c = get_c_long(col);
if (r < 1 || r > BUFFER_ROWS || c < 1 || c > BUFFER_COLS)
return NIL;
if (NULLP(bname)) {
buf = siag_buffer;
s = siag_sht;
} else if (TYPEP(bname, tc_string)) {
buf = find_sheet_by_name(bname->storage_as.string.data,
siag_buffer, &s);
if (buf == NULL) return NIL;
}
else return NIL;
switch (ret_type(buf, s, r, c)) {
case STRING:
p = ret_string(buf, s, r, c);
return strcons(strlen(p), p);
case LABEL:
p = ret_text(buf, s, r, c);
return strcons(strlen(p), p);
case EMPTY:
case ERROR:
return NIL;
default:
return flocons(ret_val(buf, s, r, c).number);
}
}
static LISP decode_fstab(struct fstab *p)
{if (p)
return(symalist("spec",strcons(-1,p->fs_spec),
"file",strcons(-1,p->fs_file),
"type",strcons(-1,p->fs_type),
"freq",flocons(p->fs_freq),
"passno",flocons(p->fs_passno),
"vfstype",rintern(p->fs_vfstype),
"mntops",strcons(-1,p->fs_mntops),
NULL));
else
return(NIL);}
LISP lgetgrgid(LISP n)
{gid_t gid;
struct group *gr;
long iflag,j;
LISP result = NIL;
gid = get_c_long(n);
iflag = no_interrupt(1);
if ((gr = getgrgid(gid)))
{result = cons(strcons(strlen(gr->gr_name),gr->gr_name),result);
for(j=0;gr->gr_mem[j];++j)
result = cons(strcons(strlen(gr->gr_mem[j]),gr->gr_mem[j]),result);
result = nreverse(result);}
no_interrupt(iflag);
return(result);}
static LISP x_get_string(LISP row, LISP col, LISP bname)
{
int r, c;
int s;
char *p;
buffer *buf;
r = get_c_long(row);
c = get_c_long(col);
if (r < 1 || r > BUFFER_ROWS || c < 1 || c > BUFFER_COLS)
return NIL;
if (NULLP(bname)) {
buf = siag_buffer;
s = siag_sht;
} else if (TYPEP(bname, tc_string)) {
buf = find_sheet_by_name(bname->storage_as.string.data,
siag_buffer, &s);
if (buf == NULL) return NIL;
}
else return NIL;
if (ret_type(buf, s, r, c) == ERROR) p = "";
else p = ret_pvalue(NULL, buf, s, r, c, -1);
return strcons(strlen(p), p);
}
static LISP limage_filename(void)
{
static char path[1024], name[1024];
char fn[1024];
char pn[1024];
char cmd[1024];
char fmt[80];
char p[1024];
buffer *buf = w_list->buf;
/* ask for file name */
if (path[0] == '\0') getcwd(path, 1024);
name[0] = fn[0] = '\0';
if (!select_file(path, name, NULL, fmt, 0)) return NIL;
sprintf(fn, "%s/%s", path, name);
plugin_unique_name(name, pn);
strcpy(name, pn);
/* copy the file */
plugin_basedir(p, buf->name);
sprintf(pn, "%s/%s", p, name);
sprintf(cmd, "(mkdir %s;cp %s %s)2>/dev/null", p, fn, pn);
system(cmd);
/* and now we don't start a plugin, but return the filename */
return strcons(strlen(pn), pn);
}
static LISP get_text(LISP row, LISP col)
{
char *text = ret_text(buffer_of_window(w_list), w_list->sht,
get_c_long(row), get_c_long(col));
if (!text) text = "";
return strcons(strlen(text), text);
}
LISP lreadlink(LISP p)
{long iflag;
char buff[PATH_MAX+1];
int size;
iflag = no_interrupt(1);
if ((size = readlink(get_c_string(p),buff,sizeof(buff))) < 0)
return(err("readlink",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(strcons(size,buff));}
static LISP lput_property(LISP bname, LISP key, LISP value)
{
buffer *b;
char *retval;
if (NULLP(bname)) b = buffer_of_window(w_list);
else b = find_buffer_by_name(get_c_string(bname));
if (!b) {
llpr("No such buffer");
return NIL;
}
retval = put_property(b, get_c_string(key), get_c_string(value));
if (retval) return strcons(strlen(retval), retval);
return NIL;
}
lref_t lread_binary_string(lref_t l, lref_t port)
{
_TCHAR buf[STACK_STRBUF_LEN];
if (!BINARY_PORTP(port))
vmerror_wrong_type_n(2, port);
if (!NUMBERP(l))
vmerror_wrong_type_n(1, l);
fixnum_t remaining_length = get_c_fixnum(l);
if (remaining_length <= 0)
vmerror_arg_out_of_range(l, _T(">0"));
lref_t new_str = strcons();
size_t total_read = 0;
while (remaining_length > 0)
{
fixnum_t to_read = remaining_length;
if (to_read > STACK_STRBUF_LEN)
to_read = STACK_STRBUF_LEN;
size_t actual_read = read_bytes(port, buf, (size_t)(remaining_length * sizeof(_TCHAR)));
if (actual_read <= 0)
break;
string_appendd(new_str, buf, actual_read);
remaining_length -= actual_read;
total_read += actual_read;
}
if (total_read == 0)
return lmake_eof();
return new_str;
}
LISP ldecode_pwent(struct passwd *p)
{return(symalist(
"name",strcons(strlen(p->pw_name),p->pw_name),
"passwd",strcons(strlen(p->pw_passwd),p->pw_passwd),
"uid",flocons(p->pw_uid),
"gid",flocons(p->pw_gid),
"dir",strcons(strlen(p->pw_dir),p->pw_dir),
"gecos",strcons(strlen(p->pw_gecos),p->pw_gecos),
/* FIXME: this is horrible */
#if defined(__osf__) || defined(hpux) || defined(sun)
"comment",strcons(strlen(p->pw_comment),p->pw_comment),
#endif
#if defined(hpux) || defined(sun)
"age",strcons(strlen(p->pw_age),p->pw_age),
#endif
#if defined(__osf__)
"quota",flocons(p->pw_quota),
#endif
"shell",strcons(strlen(p->pw_shell),p->pw_shell),
NULL));}
void realmain(int argc, char **argv)
{
char b[256];
struct stat statbuf;
/* vars from oldmain */
buffer *buf = NULL;
char path[1024];
int i;
setlocale(LC_NUMERIC, "C");
common_init("Egon Animator %s. No Warranty");
sprintf(b, "%s/%ld", siag_basedir, (long)getpid());
mkdir(b, 0700);
sprintf(b, "%s/egon.scm", siag_basedir);
egonrc = MwStrdup(b);
init_interpreters();
siod_interpreter = init_parser(argc, argv);
init_python_parser();
init_guile_parser();
init_ruby_parser();
waitforchild(0);
init_position();
init_cmds();
buf = new_buffer("noname.egon", "noname.egon");
sprintf(path, "%s/egon/egon.scm", datadir);
if (stat(path, &statbuf)) {
fprintf(stderr, "Can't find the runtime library (egon.scm).\n");
fprintf(stderr, "Expected it in %s\n", path);
fprintf(stderr, "SIAGHOME (if set) is '%s'\n", datadir);
fprintf(stderr, "Please read installation instructions.\n");
exit(EXIT_FAILURE);
}
setvar(cintern("libdir"), strcons(-1, libdir), NIL);
setvar(cintern("datadir"), strcons(-1, datadir), NIL);
setvar(cintern("docdir"), strcons(-1, docdir), NIL);
/* load runtime library */
sprintf(b, "(load \"%s/egon/egon.scm\")", datadir);
execute(b);
init_windows(buf, &argc, argv);
setlocale(LC_NUMERIC, "C"); /* possibly hosed by X */
/* load user customizations, if any */
if (!stat(egonrc, &statbuf)) {
sprintf(b, "(load \"%s\")", egonrc);
execute(b);
}
execute("(init-windows)");
execute("(create-menus)");
fileio_init();
for (i = 1; i < argc; i++) {
if (argv[i][0] != '-') {
strcpy(path, argv[i]);
free_buffer(w_list->buf);
buf = new_buffer(buffer_name(argv[i]), path);
loadmatrix(path, buf, guess_file_format(path));
buf->change = FALSE;
w_list->buf = buf;
}
}
pr_scr_flag = TRUE;
execute("(popup-editor)");
/* this works, for reasons beyond my comprehension */
execute("(print-version)");
execute("(print-version)");
activate_window(w_list);
#ifdef HAVE_LIBTCL
Tcl_Main(argc, argv, Tcl_AppInit);
#else
mainloop();
#endif
}
LISP lgetcwd(void)
{char path[PATH_MAX+1];
if (getcwd(path,sizeof(path)))
return(strcons(strlen(path),path));
else
return(err("getcwd",llast_c_errmsg(-1)));}
LISP lcrypt(LISP key,LISP salt)
{char *result;
if ((result = crypt(get_c_string(key),get_c_string(salt))))
return(strcons(strlen(result),result));
else
return(NIL);}
LISP lstatfs(LISP path)
{long iflag;
struct statfs s;
iflag = no_interrupt(1);
if (statfs(get_c_string(path),&s,sizeof(s)))
return(err("statfs",llast_c_errmsg(-1)));
no_interrupt(iflag);
return(symalist("type",(((s.f_type >= 0) && (s.f_type < MNT_NUMTYPES) &&
mnt_names[s.f_type])
? rintern(mnt_names[s.f_type])
: flocons(s.f_type)),
"bsize",flocons(s.f_bsize),
"blocks",flocons(s.f_blocks),
"bfree",flocons(s.f_bfree),
"bavail",flocons(s.f_bavail),
"files",flocons(s.f_files),
"ffree",flocons(s.f_ffree),
"mntonname",strcons(-1,s.f_mntonname),
"mntfromname",strcons(-1,s.f_mntfromname),
NULL));}
