PreviousUpNext

15.4.1309  src/lib/tk/src/windows.pkg

#  *********************************************************************** 
#                                                                          
#  Project: sml/Tk: an Tk Toolkit for sml                                  
#  Author: Burkhart Wolff, University of Bremen                            
#  Date: 25.7.95                                                           
#  Purpose of this file: Abstract data Type Window                         
#                                                                          
#  *********************************************************************** 

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


package   window
: (weak)  Window                # Window        is from   src/lib/tk/src/windows.api
{
        include basic_utilities;
        include basic_tk_types;
        include gui_state;


        #  *********************************************************************** 
        #                                                                          
        #  IMPLEMENTATION: WINDOWS                                                 
        #                                                                          
        #  *********************************************************************** 


        #  functions related to Window Namings 

        fun sel_window_naming (_, _, _, bds, _)
            =
            bds;

        fun select_bind_key_path window name
            =
            bind::get_action_by_name name (sel_window_naming (gui_state::get_window_gui window));


        #  I'm not sure if it could be called before the window is added to   
        /* the internal GUI state. Therefore True as well if no window is     */ 
        #  present as if it really is the first in the GUI state.             
        #  isInitWin . Window_ID -> GUI s -> (Bool, GUI s) 

        /* Moved To Basic_Tk_Types for visibility reasons
        fun   isInitWin w = 
             (fn ([], _) => TRUE | (window . windows, _) => (w = (window_id window))) *gui_state;
        */


        #  CHECKING the INTEGRITY of a WINDOW 

        #  window title may contain alphanumerical characters only 

        fun check_window_id ""
                =>
                FALSE;

            check_window_id s
                => 
                (char::is_lower (string::get (s, 0))) and (string_util::all char::is_alpha_num s);
        end;

        check_title = string_util::all char::is_print; 

        fun check (window as (w, wcnfgs, wids, _, _))
            = 
            {   mbt = config::sel_window_title window;
                bb  = check_window_id w;
            
                case mbt
                     NULL   => bb;
                    THE t => check_title t and bb; esac;
            };

        fun append_gui w
            =
            upd_windows_gui (get_windows_gui() @ [w]);

        fun add_gui (w as (window_id, wcnfgs, widgs, binds, act))
            = 
            if (check w)
                
                if   (paths::occurs_window_gui (get_window_id w))
                    
                     raise exception WINDOWS ("Two identical window names not allowed: " + 
                                   (get_window_id w));
                else 
                     tmp_window = (window_id, wcnfgs,
                                   if (window_is_gridded w ) GRIDDED []; else PACKED [];fi,
                                   binds, act);

                     { append_gui tmp_window;
                      widget_tree::add_widgets_gui window_id "" (get_raw_widgets widgs);};
                fi;
            else 
                raise exception WINDOWS ("Definition of window " + get_window_id w + " is not OK");fi;

        fun delete_gui w
            = 
            {   wins  = get_windows_gui();
                ass   = get_path_ass_gui();
                nwins = list::filter ((fn x => not (w==x); end ) o get_window_id) wins;
                nass  = paths::delete_window w ass;
             
                upd_gui (nwins, nass);
            };

        delete_all_gui = upd_gui([], []);


        #  2F. EXPORTED FUNCTIONS 

        fun open_w (w as (window, wconfigs, widgets, event_callbacks, init_action))
            =
            {   add_gui w;

                if (is_init_window window)
                    
                     (com::put_tcl_cmd (cat (map (config::pack_window_conf ".")
                                                 wconfigs) +
                                     cat (bind::pack_window window event_callbacks) +
                                     "bind . <Destroy> { if {\"%W\" == \".\"} {" +
                                     com::comm_to_tcl + " \"Destroy " +
                                     window + " <Destroy> " + tk_event::show() + " \"}}\n" +
                                     widget_tree::pack_widgets TRUE "" (window, "") NULL
                                                            (get_raw_widgets widgets)));
                 else
                     (com::put_tcl_cmd ("toplevel ." + window + "\n" +
                                     cat (map (config::pack_window_conf ("." + window))
                                                 wconfigs) +
                                     cat (bind::pack_window window event_callbacks) +
                                     "bind ." + window + " <Destroy> { if {\"%W\" == \"." +
                                     window + "\"} {" + com::comm_to_tcl +
                                     " \"Destroy " + window + " <Destroy> " +
                                     tk_event::show() + " \"}}\n" +
                                     (widget_tree::pack_widgets TRUE ("." + window) (window, "")
                                                             NULL (get_raw_widgets widgets))));fi;
                 init_action();
            };

        fun close window
            =
            if   (is_init_window window)
                
                 com::exit_tcl();
                 delete_all_gui;
            else
                 com::put_tcl_cmd ("destroy ." + window);
                 delete_gui window;
            fi;

        fun change_title  window_id  title
            =
            {   window   = get_window_gui window_id;
                wc    = get_window_traits window;
                wc'   = config::add_window_conf wc [WINDOW_TITLE title];
                window'  = update_window_traits window wc';
            
                if   (check_title title)
                    
                     upd_window_gui window_id window';

                     if   (is_init_window window_id)
                         
                          com::put_tcl_cmd (config::pack_window_conf  "."          (WINDOW_TITLE title));
                     else com::put_tcl_cmd (config::pack_window_conf ("." + window_id) (WINDOW_TITLE title));  fi;
                else 
                     raise exception WINDOWS ("Title " + title + " for window " + window_id + " is not OK");
                fi;
            };

    };


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext