Lisp_Object
menu_parse_submenu_keywords (Lisp_Object desc, Lisp_Object gui_item)
{
Lisp_Gui_Item *pgui_item = XGUI_ITEM (gui_item);
/* Menu descriptor should be a list */
CHECK_CONS (desc);
/* First element may be menu name, although can be omitted.
Let's think that if stuff begins with anything than a keyword
or a list (submenu), this is a menu name, expected to be a string */
if (!KEYWORDP (XCAR (desc)) && !CONSP (XCAR (desc)))
{
CHECK_STRING (XCAR (desc));
pgui_item->name = XCAR (desc);
desc = XCDR (desc);
if (!NILP (desc))
CHECK_CONS (desc);
}
/* Walk along all key-value pairs */
while (!NILP(desc) && KEYWORDP (XCAR (desc)))
{
Lisp_Object key, val;
key = XCAR (desc);
desc = XCDR (desc);
CHECK_CONS (desc);
val = XCAR (desc);
desc = XCDR (desc);
if (!NILP (desc))
CHECK_CONS (desc);
gui_item_add_keyval_pair (gui_item, key, val, ERROR_ME);
}
/* Return the rest - supposed to be a list of items */
return desc;
}
LispObj *
Lisp_MakeStringOutputStream(LispBuiltin *builtin)
/*
make-string-output-stream &key element-type
*/
{
LispObj *element_type;
element_type = ARGUMENT(0);
if (element_type != UNSPEC) {
/* just check argument... */
if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
; /* do nothing */
else if (KEYWORDP(element_type) &&
ATOMID(element_type) == Sdefault)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
}
return (LSTRINGSTREAM("", STREAM_WRITE, 1));
}
/* run-process */
BGL_EXPORTED_DEF obj_t BGl_runzd2processzd2zz__processz00(obj_t
BgL_commandz00_14, obj_t BgL_restz00_15)
{
AN_OBJECT;
{ /* Llib/process.scm 211 */
{ /* Llib/process.scm 212 */
obj_t BgL_forkz00_759;
obj_t BgL_waitz00_760;
obj_t BgL_inputz00_761;
obj_t BgL_outputz00_762;
obj_t BgL_errorz00_763;
obj_t BgL_hostz00_764;
obj_t BgL_pipesz00_765;
obj_t BgL_argsz00_766;
obj_t BgL_envz00_767;
BgL_forkz00_759 = BTRUE;
BgL_waitz00_760 = BFALSE;
BgL_inputz00_761 = BUNSPEC;
BgL_outputz00_762 = BUNSPEC;
BgL_errorz00_763 = BUNSPEC;
BgL_hostz00_764 = BUNSPEC;
BgL_pipesz00_765 = BGl_list2216z00zz__processz00;
BgL_argsz00_766 = BNIL;
BgL_envz00_767 = BNIL;
{
obj_t BgL_restz00_770;
BgL_restz00_770 = BgL_restz00_15;
BgL_zc3anonymousza31880ze3z83_771:
if (NULLP(BgL_restz00_770))
{ /* Llib/process.scm 228 */
obj_t BgL_arg1882z00_773;
BgL_arg1882z00_773 = bgl_reverse_bang(BgL_argsz00_766);
return
c_run_process(BgL_hostz00_764, BgL_forkz00_759, BgL_waitz00_760,
BgL_inputz00_761, BgL_outputz00_762, BgL_errorz00_763,
BgL_commandz00_14, BgL_arg1882z00_773, BgL_envz00_767);
}
else
{ /* Llib/process.scm 229 */
bool_t BgL_testz00_1683;
{ /* Llib/process.scm 229 */
bool_t BgL_testz00_1684;
{ /* Llib/process.scm 229 */
obj_t BgL_auxz00_1685;
BgL_auxz00_1685 = CAR(BgL_restz00_770);
BgL_testz00_1684 = KEYWORDP(BgL_auxz00_1685);
}
if (BgL_testz00_1684)
{ /* Llib/process.scm 229 */
obj_t BgL_auxz00_1688;
BgL_auxz00_1688 = CDR(BgL_restz00_770);
BgL_testz00_1683 = PAIRP(BgL_auxz00_1688);
}
else
{ /* Llib/process.scm 229 */
BgL_testz00_1683 = ((bool_t) 0);
}
}
if (BgL_testz00_1683)
{ /* Llib/process.scm 230 */
obj_t BgL_valz00_775;
{ /* Llib/process.scm 230 */
obj_t BgL_pairz00_1250;
BgL_pairz00_1250 = BgL_restz00_770;
BgL_valz00_775 = CAR(CDR(BgL_pairz00_1250));
}
{ /* Llib/process.scm 231 */
obj_t BgL_casezd2valuezd2_776;
BgL_casezd2valuezd2_776 = CAR(BgL_restz00_770);
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2219z00zz__processz00))
{ /* Llib/process.scm 231 */
if (BOOLEANP(BgL_valz00_775))
{ /* Llib/process.scm 233 */
BgL_waitz00_760 = BgL_valz00_775;
}
else
{ /* Llib/process.scm 233 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00, BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2223z00zz__processz00))
{ /* Llib/process.scm 231 */
if (BOOLEANP(BgL_valz00_775))
{ /* Llib/process.scm 237 */
BgL_forkz00_759 = BgL_valz00_775;
}
else
{ /* Llib/process.scm 237 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2225z00zz__processz00))
{ /* Llib/process.scm 241 */
bool_t BgL_testz00_1706;
if (STRINGP(BgL_valz00_775))
{ /* Llib/process.scm 241 */
BgL_testz00_1706 = ((bool_t) 1);
}
else
{ /* Llib/process.scm 241 */
BgL_testz00_1706 =
CBOOL
(BGl_memqz00zz__r4_pairs_and_lists_6_3z00
(BgL_valz00_775, BgL_pipesz00_765));
}
if (BgL_testz00_1706)
{ /* Llib/process.scm 241 */
BgL_inputz00_761 = BgL_valz00_775;
}
else
{ /* Llib/process.scm 241 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2227z00zz__processz00))
{ /* Llib/process.scm 245 */
bool_t BgL_testz00_1714;
if (STRINGP(BgL_valz00_775))
{ /* Llib/process.scm 245 */
BgL_testz00_1714 = ((bool_t) 1);
}
else
{ /* Llib/process.scm 245 */
if (CBOOL
(BGl_memqz00zz__r4_pairs_and_lists_6_3z00
(BgL_valz00_775, BgL_pipesz00_765)))
{ /* Llib/process.scm 245 */
BgL_testz00_1714 = ((bool_t) 1);
}
else
{ /* Llib/process.scm 245 */
BgL_testz00_1714 =
(BgL_valz00_775 ==
BGl_keyword2229z00zz__processz00);
}
}
if (BgL_testz00_1714)
{ /* Llib/process.scm 245 */
BgL_outputz00_762 = BgL_valz00_775;
}
else
{ /* Llib/process.scm 245 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2231z00zz__processz00))
{ /* Llib/process.scm 249 */
bool_t BgL_testz00_1724;
if (STRINGP(BgL_valz00_775))
{ /* Llib/process.scm 249 */
BgL_testz00_1724 = ((bool_t) 1);
}
else
{ /* Llib/process.scm 249 */
if (CBOOL
(BGl_memqz00zz__r4_pairs_and_lists_6_3z00
(BgL_valz00_775,
BgL_pipesz00_765)))
{ /* Llib/process.scm 249 */
BgL_testz00_1724 = ((bool_t) 1);
}
else
{ /* Llib/process.scm 249 */
BgL_testz00_1724 =
(BgL_valz00_775 ==
BGl_keyword2229z00zz__processz00);
}
}
if (BgL_testz00_1724)
{ /* Llib/process.scm 249 */
BgL_errorz00_763 = BgL_valz00_775;
}
else
{ /* Llib/process.scm 249 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2233z00zz__processz00))
{ /* Llib/process.scm 231 */
if (STRINGP(BgL_valz00_775))
{ /* Llib/process.scm 253 */
BgL_hostz00_764 =
BgL_valz00_775;
}
else
{ /* Llib/process.scm 253 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
if (
(BgL_casezd2valuezd2_776 ==
BGl_keyword2235z00zz__processz00))
{ /* Llib/process.scm 231 */
if (STRINGP(BgL_valz00_775))
{ /* Llib/process.scm 257 */
BgL_envz00_767 =
MAKE_PAIR(BgL_valz00_775,
BgL_envz00_767);
}
else
{ /* Llib/process.scm 257 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
else
{ /* Llib/process.scm 231 */
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00,
BgL_restz00_770);
}
}
}
}
}
}
}
}
{
obj_t BgL_restz00_1744;
BgL_restz00_1744 = CDR(CDR(BgL_restz00_770));
BgL_restz00_770 = BgL_restz00_1744;
goto BgL_zc3anonymousza31880ze3z83_771;
}
}
else
{ /* Llib/process.scm 263 */
bool_t BgL_testz00_1747;
{ /* Llib/process.scm 263 */
obj_t BgL_auxz00_1748;
BgL_auxz00_1748 = CAR(BgL_restz00_770);
BgL_testz00_1747 = STRINGP(BgL_auxz00_1748);
}
if (BgL_testz00_1747)
{ /* Llib/process.scm 263 */
{ /* Llib/process.scm 264 */
obj_t BgL_arg1906z00_799;
BgL_arg1906z00_799 = CAR(BgL_restz00_770);
BgL_argsz00_766 =
MAKE_PAIR(BgL_arg1906z00_799, BgL_argsz00_766);
}
{
obj_t BgL_restz00_1753;
BgL_restz00_1753 = CDR(BgL_restz00_770);
BgL_restz00_770 = BgL_restz00_1753;
goto BgL_zc3anonymousza31880ze3z83_771;
}
}
else
{ /* Llib/process.scm 263 */
return
BGl_errorz00zz__errorz00
(BGl_string2221z00zz__processz00,
BGl_string2222z00zz__processz00, BgL_restz00_770);
}
}
}
}
}
}
}
/* XXX Non standard functions below
*/
LispObj *
Lisp_MakePipe(LispBuiltin *builtin)
/*
make-pipe command-line &key :direction :element-type :external-format
*/
{
char *string;
LispObj *stream = NIL;
int flags, direction;
LispFile *error_file;
LispPipe *program;
int ifd[2];
int ofd[2];
int efd[2];
char *argv[4];
LispObj *command_line, *odirection, *element_type, *external_format;
external_format = ARGUMENT(3);
element_type = ARGUMENT(2);
odirection = ARGUMENT(1);
command_line = ARGUMENT(0);
if (PATHNAMEP(command_line))
command_line = CAR(command_line->data.quote);
else if (!STRINGP(command_line))
LispDestroy("%s: %s is a bad pathname",
STRFUN(builtin), STROBJ(command_line));
if (odirection != UNSPEC) {
direction = -1;
if (KEYWORDP(odirection)) {
if (odirection == Kprobe)
direction = DIR_PROBE;
else if (odirection == Kinput)
direction = DIR_INPUT;
else if (odirection == Koutput)
direction = DIR_OUTPUT;
else if (odirection == Kio)
direction = DIR_IO;
}
if (direction == -1)
LispDestroy("%s: bad :DIRECTION %s",
STRFUN(builtin), STROBJ(odirection));
}
else
direction = DIR_INPUT;
if (element_type != UNSPEC) {
/* just check argument... */
if (SYMBOLP(element_type) && ATOMID(element_type) == Scharacter)
; /* do nothing */
else if (KEYWORDP(element_type) && ATOMID(element_type) == Sdefault)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
}
if (external_format != UNSPEC) {
/* just check argument... */
if (SYMBOLP(external_format) && ATOMID(external_format) == Scharacter)
; /* do nothing */
else if (KEYWORDP(external_format) &&
ATOMID(external_format) == Sdefault)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format));
}
string = THESTR(command_line);
program = LispMalloc(sizeof(LispPipe));
if (direction != DIR_PROBE) {
argv[0] = "sh";
argv[1] = "-c";
argv[2] = string;
argv[3] = NULL;
pipe(ifd);
pipe(ofd);
pipe(efd);
if ((program->pid = fork()) == 0) {
close(0);
close(1);
close(2);
dup2(ofd[0], 0);
dup2(ifd[1], 1);
dup2(efd[1], 2);
close(ifd[0]);
close(ifd[1]);
close(ofd[0]);
close(ofd[1]);
close(efd[0]);
close(efd[1]);
execve("/bin/sh", argv, environ);
exit(-1);
}
else if (program->pid < 0)
LispDestroy("%s: fork: %s", STRFUN(builtin), strerror(errno));
program->input = LispFdopen(ifd[0], FILE_READ | FILE_UNBUFFERED);
close(ifd[1]);
program->output = LispFdopen(ofd[1], FILE_WRITE | FILE_UNBUFFERED);
close(ofd[0]);
error_file = LispFdopen(efd[0], FILE_READ | FILE_UNBUFFERED);
close(efd[1]);
}
else {
program->pid = -1;
program->input = program->output = error_file = NULL;
}
flags = direction == DIR_PROBE ? 0 : STREAM_READ;
program->errorp = FILESTREAM(error_file, command_line, flags);
flags = 0;
if (direction != DIR_PROBE) {
if (direction == DIR_INPUT || direction == DIR_IO)
flags |= STREAM_READ;
if (direction == DIR_OUTPUT || direction == DIR_IO)
flags |= STREAM_WRITE;
}
stream = PIPESTREAM(program, command_line, flags);
LispMused(program);
return (stream);
}
LispObj *
Lisp_Open(LispBuiltin *builtin)
/*
open filename &key direction element-type if-exists if-does-not-exist external-format
*/
{
GC_ENTER();
char *string;
LispObj *stream = NIL;
int mode, flags, direction, exist, noexist, file_exist;
LispFile *file;
LispObj *filename, *odirection, *element_type, *if_exists,
*if_does_not_exist, *external_format;
external_format = ARGUMENT(5);
if_does_not_exist = ARGUMENT(4);
if_exists = ARGUMENT(3);
element_type = ARGUMENT(2);
odirection = ARGUMENT(1);
filename = ARGUMENT(0);
if (STRINGP(filename)) {
filename = APPLY1(Oparse_namestring, filename);
GC_PROTECT(filename);
}
else if (STREAMP(filename)) {
if (filename->data.stream.type != LispStreamFile)
LispDestroy("%s: %s is not a FILE-STREAM",
STRFUN(builtin), STROBJ(filename));
filename = filename->data.stream.pathname;
}
else {
CHECK_PATHNAME(filename);
}
if (odirection != UNSPEC) {
direction = -1;
if (KEYWORDP(odirection)) {
if (odirection == Kprobe)
direction = DIR_PROBE;
else if (odirection == Kinput)
direction = DIR_INPUT;
else if (odirection == Koutput)
direction = DIR_OUTPUT;
else if (odirection == Kio)
direction = DIR_IO;
}
if (direction == -1)
LispDestroy("%s: bad :DIRECTION %s",
STRFUN(builtin), STROBJ(odirection));
}
else
direction = DIR_INPUT;
if (element_type != UNSPEC) {
/* just check argument... */
if (SYMBOLP(element_type) &&
ATOMID(element_type) == Scharacter)
; /* do nothing */
else if (KEYWORDP(element_type) &&
ATOMID(element_type) == Sdefault)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :ELEMENT-TYPE, not %s",
STRFUN(builtin), Sdefault, Scharacter, STROBJ(element_type));
}
if (if_exists != UNSPEC) {
exist = -1;
if (if_exists == NIL)
exist = EXT_NIL;
else if (KEYWORDP(if_exists)) {
if (if_exists == Kerror)
exist = EXT_ERROR;
else if (if_exists == Knew_version)
exist = EXT_NEW_VERSION;
else if (if_exists == Krename)
exist = EXT_RENAME;
else if (if_exists == Krename_and_delete)
exist = EXT_RENAME_DELETE;
else if (if_exists == Koverwrite)
exist = EXT_OVERWRITE;
else if (if_exists == Kappend)
exist = EXT_APPEND;
else if (if_exists == Ksupersede)
exist = EXT_SUPERSEDE;
}
if (exist == -1)
LispDestroy("%s: bad :IF-EXISTS %s",
STRFUN(builtin), STROBJ(if_exists));
}
else
exist = EXT_ERROR;
if (if_does_not_exist != UNSPEC) {
noexist = -1;
if (if_does_not_exist == NIL)
noexist = NOEXT_NIL;
if (KEYWORDP(if_does_not_exist)) {
if (if_does_not_exist == Kerror)
noexist = NOEXT_ERROR;
else if (if_does_not_exist == Kcreate)
noexist = NOEXT_CREATE;
}
if (noexist == -1)
LispDestroy("%s: bad :IF-DOES-NO-EXISTS %s",
STRFUN(builtin), STROBJ(if_does_not_exist));
}
else
noexist = direction != DIR_INPUT ? NOEXT_NOTHING : NOEXT_ERROR;
if (external_format != UNSPEC) {
/* just check argument... */
if (SYMBOLP(external_format) &&
ATOMID(external_format) == Scharacter)
; /* do nothing */
else if (KEYWORDP(external_format) &&
ATOMID(external_format) == Sdefault)
; /* do nothing */
else
LispDestroy("%s: only :%s and %s supported for :EXTERNAL-FORMAT, not %s",
STRFUN(builtin), Sdefault, Scharacter, STROBJ(external_format));
}
/* string representation of pathname */
string = THESTR(CAR(filename->data.pathname));
mode = 0;
file_exist = access(string, F_OK) == 0;
if (file_exist) {
if (exist == EXT_NIL) {
GC_LEAVE();
return (NIL);
}
}
else {
if (noexist == NOEXT_NIL) {
GC_LEAVE();
return (NIL);
}
if (noexist == NOEXT_ERROR)
LispDestroy("%s: file %s does not exist",
STRFUN(builtin), STROBJ(CAR(filename->data.quote)));
else if (noexist == NOEXT_CREATE) {
LispFile *tmp = LispFopen(string, FILE_WRITE);
if (tmp)
LispFclose(tmp);
else
LispDestroy("%s: cannot create file %s",
STRFUN(builtin),
STROBJ(CAR(filename->data.quote)));
}
}
if (direction == DIR_OUTPUT || direction == DIR_IO) {
if (file_exist) {
if (exist == EXT_ERROR)
LispDestroy("%s: file %s already exists",
STRFUN(builtin), STROBJ(CAR(filename->data.quote)));
if (exist == EXT_RENAME) {
/* Add an ending '~' at the end of the backup file */
char tmp[PATH_MAX + 1];
strcpy(tmp, string);
if (strlen(tmp) + 1 > PATH_MAX)
LispDestroy("%s: backup name for %s too long",
STRFUN(builtin),
STROBJ(CAR(filename->data.quote)));
strcat(tmp, "~");
if (rename(string, tmp))
LispDestroy("%s: rename: %s",
STRFUN(builtin), strerror(errno));
mode |= FILE_WRITE;
}
else if (exist == EXT_OVERWRITE)
mode |= FILE_WRITE;
else if (exist == EXT_APPEND)
mode |= FILE_APPEND;
}
else
mode |= FILE_WRITE;
if (direction == DIR_IO)
mode |= FILE_IO;
}
else
mode |= FILE_READ;
file = LispFopen(string, mode);
if (file == NULL)
LispDestroy("%s: open: %s", STRFUN(builtin), strerror(errno));
flags = 0;
if (direction == DIR_PROBE) {
LispFclose(file);
file = NULL;
}
else {
if (direction == DIR_INPUT || direction == DIR_IO)
flags |= STREAM_READ;
if (direction == DIR_OUTPUT || direction == DIR_IO)
flags |= STREAM_WRITE;
}
stream = FILESTREAM(file, filename, flags);
GC_LEAVE();
return (stream);
}
