PreviousUpNext

15.4.1293  src/lib/tk/src/sys_init.pkg

## sys_init.pkg
## Author: stefan (Last modification by $Author: 2cxl $)
## (C) 1996, Bremen Institute for Safe Systems (BISS), University of Bremen. 

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


# **************************************************************************

# Initialization functions for tk

# $Date: 2001/03/30 13:39:19 $
# $Revision: 3.0 $
#
#
# **************************************************************************



api Sys_Init {

     getenv:       String -> String null_or::Null_Or; 
     init_sml_tk:  Void -> Void;
};


package sys_init: (weak)  Sys_Init
=
package {

    include package  basic_tk_types;
    include package  basic_utilities::file_util;
    include package  com_state;

    old_display = REF "";

    fun get_display ()
        =    
        {   display = null_or::the_else (winix__premicrothread::process::get_env "DISPLAY", "");
            host= null_or::the_else (winix__premicrothread::process::get_env "HOSTNAME", "");
        
            (   if (string::get_byte_as_char (display, 0)== ':')
                     #
                     host$display;           #  prefix with host name if display name is ":0.0" or some such 
                else display;
                fi
            )
            except
                INDEX_OUT_OF_BOUNDS
                    =
                    host$":0";
        };
            
    fun is_file_rd_and_ex pn
        =
        #       winix__premicrothread::file::access (pn,[winix__premicrothread::file::MAY_READ, winix__premicrothread::file::MAY_EXECUTE]) 
        winix__premicrothread::file::access (pn,[winix__premicrothread::file::MAY_READ]);
        
    fun is_file_rd pn
        =
        winix__premicrothread::file::access (pn, [winix__premicrothread::file::MAY_READ]);
        
    fun is_readable_and_writable_directory pn
        =
        (winix__premicrothread::file::access (pn,[winix__premicrothread::file::MAY_READ, winix__premicrothread::file::MAY_WRITE]))
        and
        (winix__premicrothread::file::is_directory pn);
    #
    fun getenv name
        = 
        # read an environment variable NAME. A command line setting of
        # --name=... overrides the environment variable. 

        {   # This is the command line option
            # which overrides the env::var: 

            envsetting = "--" + (string::map char::to_lower name);

            # Get command line args (so we reparse them for every variable 
            # but this only happens when we start so it's ok)

            cmds = (map (string::fields (\\ c   =   c == '='))) 
                   (commandline::get_args());
        
            case (list::find
                      \\ name . arg . _   =>   name == envsetting; 
                                        _ =>   FALSE;
                      end
                      cmds
                 )

                THE (_ . setting . _)
                    =>
                    THE setting;                   

                NULL =>
                    # Not found, try unix environment:
                    #
                    winix__premicrothread::process::get_env name;
            esac;
        };

    #
    fun check_upd_paths ()
        =       
        {   # Check and update settings if necessary.
            # Note that logging is turned off it SMLTK_LOG is not set,
            # whereas the paths to the lib and the wish remain unchanged
            # if SMLTK_LIB and SMLTK_TCL do not exist:

            update_lib_path (null_or::the (getenv (sys_conf::lib_var.name)))
            except
                null_or::NULL_OR
                    =
                    ();

            upd_logfilename (getenv (sys_conf::logfile_var.name));

            upd_wish_path (null_or::the (getenv (sys_conf::wish_var.name)))
            except
                null_or::NULL_OR
                    =
                    ();

            # Now check the (possbily updated) paths: 
            #
            {   wish_ok = is_file_rd_and_ex (get_wish_path());
                lib_ok  = is_readable_and_writable_directory (get_lib_path()); #  Writeable ?!?! 

                testfont = fonts::get_testfont_path (get_lib_path());

                font_ok = is_file_rd_and_ex (testfont);
                dpy_ok  = null_or::not_null (winix__premicrothread::process::get_env "DISPLAY");
            
                file::write (file::stdout, "\ntk parameter settings:\n\
                                \--------------------------\n");

                file::write
                  ( file::stdout,

                    "wish (SMLTK_TCL)       : " + (get_wish_path())  +         
                     if (not wish_ok ) 
                          " *** WARNING: no executable found!\n";
                     else "\n";
                     fi
                  );

                file::write
                  ( file::stdout,

                    "library (SMLTK_LIB)    : " + (get_lib_path())  + 
                         if (not lib_ok )
                              " *** WARNING: not a r/w directory!\n"; 
                         else "\n";
                         fi
                  );          

                if (not font_ok) 
                     file::write (file::stdout, 
                                   "*** WARNING: no executable `testfont` found at " + testfont + "\n");
                fi;

                if (not dpy_ok) 
                      file::write (file::stdout, 
                                    "*** WARNING: environmnent variable DISPLAY not set.\n");
                fi;

                case (get_logfilename ())
                    NULL   => file::write (file::stdout, "logfile (SMLTK_LOGFILE): NULL\n");
                    THE f => file::write (file::stdout, "logfile (SMLTK_LOGFILE): " + f + "\n");
                esac;


                if (not (wish_ok and font_ok and lib_ok and dpy_ok))
                    
                    file::write (file::stderr, "\n*** Warnings have occurred, tk malfunction likely.\n\n");
                fi;
            };
        };

    # The following functions should go into sys_dep,
    # but that leads to  a cycle in the definitions:


#    local use Signals posix::tty in
#
#    fun initTTY () =
#        let #  Configure TTY driver to make ^\ generate sigQUIT 
#            my { iflag, oflag, cflag, lflag, cc, ispeed, ospeed } = 
#                        fieldsOf (getattr posix::stdin)
#            nuattr= termios { iflag, oflag, cflag, 
#                                 lflag, ispeed, ospeed,
#                                 cc=v::update (cc, [(v::quit, char::from_int 28)]) }
#        in  setattr (posix::stdin, tc::sanow, nuattr);
#            #  install the top level fate as QUIT signal handler 
#            /* (This doesn't really work because we get uncaught exceptions,
#             *  but at least we return to the top level...) */
#            setHandler (posix_signals::sigQUIT, 
#                       HANDLER (\\ _ => *unsafe::sigint_fate));
#                    #  ignore broken pipes, so SML doesn't terminate when wish dies 
#            setHandler (posix_signals::sigPIPE, IGNORE);
#            /* ignore interrupts-- they are only enabled (and handled) while
#             * calling functions bound to events */
#            setHandler (sigINT, IGNORE);
#            #  Announce these changes 
#            print "\nNote: use INTR (Ctrl-C) to stop diverging computations,\
#                   \\n      use QUIT (Ctrl-\\) to abort tk's toplevel.\n\n"
#         end

#    fun resetTTY () =
#       ignore (setHandler (sigINT, inqHandler posix_signals::sigQUIT);
#             setHandler (posix_signals::sigQUIT, IGNORE))
#    end

        
    fun init_sml_tk ()
        =
        {   check_upd_paths();

            sys_dep::init_tty
                (\\ () = print"[tk] Abort.\n");

            # Default initializiation for the wish:
            #
            upd_tcl_init
              " set tcl_prompt1 \"puts -nonewline {} \" \n \
               \ set tcl_prompt2 \"puts -nonewline {} \" \n ";

            # If DISPLAY has changed, re-initialize fonts: 
            #
            {   nu_display= get_display();
            
                if (nu_display != *old_display)
                     
                     old_display := nu_display;
                     fonts::init (get_lib_path());
                fi;
            };
       };

};





Comments and suggestions to: bugs@mythryl.org

PreviousUpNext