/* ***************************************************************************
The communication state (loosely coupled version).
Author: bu & behrends
(C) 1998, ALU Freiburg
************************************************************************** */
# Compiled by:
# src/lib/tk/src/tk.sublibpackage com_state
: (weak) Com_State # Com_State is from src/lib/tk/src/com-state.api{
include package basic_tk_types;
include package basic_utilities;
prelude_tcl
=
"proc Write { msg } { \n \
\ puts stdout $msg \n \
\ flush stdout \n \
\} \n \
\proc SWrite { msg my } { \n \
\ puts stdout \"$msg $my\" \n \
\ flush stdout \n \
\} \n \
\proc WriteSec { tag msg } { \n \
\ set status [catch { eval $msg } res] \n \
\ if {$status == 0 } { \n \
\ puts stdout \"$tag $res\" \n \
\ } else { \n \
\ puts stdout \"ERROR $res\" \n \
\ } \n \
\ flush stdout \n \
\} \n \
\proc WriteCmd { tag msg } { \n \
\ set status [catch { eval $msg } res] \n \
\ if {$status == 0 } { \n \
\ puts stdout \"$tag\" \n \
\ } else { \n \
\ puts stdout \"ERROR $res\" \n \
\ } \n \
\ flush stdout \n \
\} \n \
\proc WriteM { msg } { \n \
\ puts stdout $msg \n \
\ flush stdout \n \
\ puts \"EOM\" \n \
\ flush stdout \n \
\} \n ";
fun get_env (ev: sys_conf::Env_Var)
=
null_or::the (winix__premicrothread::process::get_env ev.name)
except
null_or::NULL_OR
=
ev.default;
Wish_App
=
{ inp: file::Input_Stream,
out: file::Output_Stream,
prot: null_or::Null_Or( file::Output_Stream )
};
com_state
=
REF {
wapp => NULL: null_or::Null_Or( Wish_App ),
logfile => winix__premicrothread::process::get_env (sys_conf::logfile_var.name),
wish => get_env (sys_conf::wish_var),
tcl_init => " set tcl_prompt1 \"puts -nonewline {} \" \n \
\ set tcl_prompt2 \"puts -nonewline {} \" \n ",
lib_path => get_env (sys_conf::lib_var),
tcl_answers => []:List( Tcl_Answer )
};
fun get_wish_data ()
=
null_or::the (.wapp *com_state);
fun wish_active ()
=
null_or::not_null (.wapp *com_state);
get_wish_in = .inp o get_wish_data;
get_wish_out = .out o get_wish_data;
get_wish_prot = .prot o get_wish_data;
fun upd_wish_data nw
=
{ my { wish, logfile, tcl_init, lib_path, tcl_answers, ... }
=
*com_state;
com_state
:=
{ wapp => nw,
logfile, wish, tcl_init,
lib_path, tcl_answers
};
};
fun get_logfilename ()
=
.logfile *com_state;
fun upd_logfilename log
=
{ my { wapp, wish, tcl_init, lib_path, tcl_answers, ... }
=
*com_state;
com_state:= { wapp, logfile=>log, wish,
tcl_init, lib_path, tcl_answers };
};
fun get_wish_path ()
=
.wish *com_state;
fun upd_wish_path wp
=
{ my { wapp, logfile, tcl_init, lib_path, tcl_answers, ... }
=
*com_state;
com_state:= { wapp, logfile, wish=> wp,
tcl_init, lib_path, tcl_answers };
};
fun get_tcl_init ()
=
.tcl_init *com_state;
fun upd_tcl_init ti
=
{ my { wapp, logfile, wish, lib_path, tcl_answers, ... }
=
*com_state;
com_state
:=
{ wapp, logfile, wish,
tcl_init=> ti,
lib_path, tcl_answers
};
};
fun get_lib_path ()
=
.lib_path *com_state;
fun update_lib_path rp
=
{ my { wapp, logfile, wish, tcl_init, tcl_answers, ... }
=
*com_state;
com_state
:=
{ wapp, logfile, wish,
tcl_init, lib_path=> rp, tcl_answers
};
};
fun get_tcl_answers_gui ()
=
.tcl_answers *com_state;
fun upd_tcl_answers_gui nansw
=
{ my { wapp, logfile, wish, tcl_init, lib_path, tcl_answers }
=
*com_state;
com_state
:=
{ wapp, logfile, wish,
tcl_init, lib_path, tcl_answers=>nansw
};
};
# fun initStream st = streamToIODesc st;
fun init_com_state ()
=
com_state
:=
{ wapp => NULL,
logfile => get_logfilename (),
wish => get_wish_path(),
tcl_init => get_tcl_init(),
lib_path => get_lib_path(),
tcl_answers => []
};
fun init_wish ()
=
{ my (inp, out)
=
file_util::execute (get_wish_path (),[]);
prot = null_or::map file::open (get_logfilename());
upd_wish_data (THE { inp, out, prot } );
};
fun get_event ()
=
{ string_or_null = file::read_line (get_wish_in());
string
=
case string_or_null
THE string => string;
NULL => ""; # 2006-11-27 CrT Quick fix during installation -- what's right here? XXX BUGGO FIXME
esac;
string;
}
except
null_or::NULL_OR = ""; /* wish has been closed in the meantime */
fun eval ps
=
{ out= get_wish_out();
file::write (out, ps + "\n");
file::flush (out);
}
except
null_or::NULL_OR = (); # wish has been closed in the meantime
fun close_wish ()
=
{ my { inp, out, ... }
=
get_wish_data();
file::close_input inp;
file::close out;
upd_wish_data NULL;
}
except
_ = upd_wish_data NULL;
# dummy functions (they are used in integrated version)
# to keep the code consistent:
fun do_one_event () = 1; # why not 2 ?!?
fun do_one_event_without_waiting () = 1; # Ditto
fun reset_tcl_interp () = ();
};