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));}