PreviousUpNext

15.4.1244  src/lib/tk/src/com-state.pkg

/* ***************************************************************************
   The communication state (loosely coupled version).
   Author: bu & behrends 
   (C) 1998, ALU Freiburg
  ************************************************************************** */

# Compiled by:
#     src/lib/tk/src/tk.sublib

package   com_state
: (weak)  Com_State                             # Com_State     is from   src/lib/tk/src/com-state.api
{
    include basic_tk_types;
    include 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 () = ();


};




Comments and suggestions to: bugs@mythryl.org

PreviousUpNext