PreviousUpNext

15.4.1277  src/lib/tk/src/toolkit/enter_windows.pkg

## enter_windows.pkg
## Author: bu/kol/cxl
## (C) 1997-99, Bremen Institute for Safe Systems, Universitaet Bremen

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



###                       "For a successful technology,
###                        reality must take precedence
###                        over public relations, for
###                        Nature cannot be fooled."
###
###                                   -- Richard P. Feynman 



# ***************************************************************************
# Windows to enter substitutions or related data structures.
# **************************************************************************


api Subst_Window {

    # a substitution is a list [(p_i, str_i)] of pairs of strings,
    # where p_i is the "parameter names" and str_i its value. 
    #
    # In the following, new creates a new list of substitutions,
    # ie. str_i are (initially) empty, whereas edit takes an existing
    # substitution. The "title" below is the window title.


     new:  { title:   String,
               width:   Int,
               params:  List( String ),
               cc:      List ((String, String)) -> Void } -> Void;

     edit:  { title:  String,
                width:  Int,
                subst:  List ((String, String)),
                cc:     List ((String, String)) -> Void } -> Void;
}; 


package subst_window: (weak) Subst_Window {             # Subst_Window  is from   src/lib/tk/src/toolkit/enter_windows.pkg

    include tk; 

    /* These lines, copied from util_window here, should go into some general
     * configuration thingy */

    msg_font      = NORMAL_FONT [];
    msg_width     = 40;
    button_relief = RAISED;
    button_width  = 5;
    button_font   = SANS_SERIF [];          
    enter_text_font = TYPEWRITER [];
        
    fun upto (from, to)
        =
        if (to < from   ) [];
                       else from . upto (from+1, to);fi;

    fun do_subst (width, sep, wintitle, subst, cc)
        =
        {   # Width of variable entry boxes:
            # max. length of a var. name + 2
            #
            var_width = (fold_backward
                            (fn ((a, _), m)
                                =
                               if   (size a  >  m)
                                    size a;
                               else m;  fi
                             )
                             0
                             subst
                        )
                        + 2;

            # Some widget ids:
            #
            fun lhs_wid_id (w, n) =  make_sub_widget_id  (w, "substLhs" $ int::to_string n);
            fun rhs_wid_id (w, n) =  make_sub_widget_id  (w, "substRhs" $ int::to_string n);
            fun subst_frm_id  w   =  make_sub_widget_id  (w, "substFrm");
            fun add_button_id w   =  make_sub_widget_id  (w, "substBttn");
            fun cls_button_id w   =  make_sub_widget_id  (w, "substCls");

            fun zip_it s
                =
                paired_lists::zip (upto (1, length s), s);
                
            # Entry box for one substitution:
            #
            fun one_entry w (n, (par, str))
                = 
                FRAME {
                    widget_id       => make_widget_id(), 
                    packing_hints   => [PACK_AT TOP],
                    traits          => [],
                    event_callbacks => [],

                    subwidgets => PACKED [

                                     TEXT_ENTRY {
                                         widget_id       => lhs_wid_id (w, n),
                                         packing_hints   =>  [PACK_AT LEFT],
                                         event_callbacks => [],

                                         traits          => [   WIDTH var_width,
                                                               FONT enter_text_font
                                                           ]
                                     },

                                     LABEL {
                                         widget_id       => make_widget_id (),
                                         packing_hints   => [ PACK_AT LEFT ], 
                                         traits          => [TEXT sep],
                                         event_callbacks => []
                                     },

                                     TEXT_ENTRY {
                                         widget_id       => rhs_wid_id (w, n),
                                         packing_hints   => [PACK_AT RIGHT], 
                                         event_callbacks => [],
                                         traits          => [   WIDTH width,
                                                               FONT enter_text_font
                                                           ]
                                     }
                                 ]
                };

            # frame with all substitutions.
            # Needs to be one frame so we
            # can add new subst-entry boxes:

            fun all_substs w substs
                =
                FRAME {
                    widget_id       => (subst_frm_id w), 
                    subwidgets      => PACKED (map (one_entry w) (zip_it subst)),
                    packing_hints   => [PACK_AT TOP],
                    traits          => [],
                    event_callbacks => []
                };

            # Close window, read values, continue with cc:

            fun close_subst (window, wid, n)
                =
                {   fun get_sub n = (get_tcl_text (lhs_wid_id (wid, n)), 
                                    get_tcl_text (rhs_wid_id (wid, n)));

                    subst = list::filter (fn (p, _)=> not (p==""); end )
                                            (map get_sub (upto (1, n)));
                
                    close_window window; 
                    cc subst;
                };

            /* add another entry box.
             * Note reconfiguration of the commands
             * bound to the add-button and the close-button 
             */
            fun add_subst (window, wid, n)
                =
                {   add_trait (add_button_id wid)
                         [CALLBACK (make_simple_callback (fn()=> add_subst (window, wid, n+1); end ))];

                    add_trait (cls_button_id wid)
                         [CALLBACK (make_simple_callback (fn()=> close_subst (window, wid, n+1); end ))];

                    add_widget window (subst_frm_id wid) (one_entry wid (n+1, ("", "")));
                };

            fun subst_frame (window, wid)
                =
                FRAME {
                    widget_id => make_widget_id(),
                    packing_hints => [PACK_AT TOP, FILL ONLY_X],
                    traits => [],
                    event_callbacks => [],
                    subwidgets => PACKED [ all_substs wid subst,
                                     BUTTON {
                                         widget_id => (add_button_id wid),
                                         packing_hints => [PACK_AT TOP, FILL ONLY_X],
                                         event_callbacks => [],
                                         traits        => [   WIDTH var_width,
                                                             TEXT "Add Parameter", FONT button_font,
                                                             CALLBACK (make_simple_callback (fn()=> 
                                                                        add_subst (window, wid, length subst); end ))
                                                         ]
                                     }
                                   ]
                };

            fun button_frm (window, wid)
                =
                FRAME {

                    widget_id       => make_widget_id(),
                    packing_hints   => [FILL ONLY_X, PACK_AT BOTTOM], 

                    traits          => [],
                    event_callbacks => [],

                    subwidgets
                        =>
                        PACKED [
                            BUTTON {
                                widget_id       => (cls_button_id wid),
                                packing_hints   => [PACK_AT RIGHT], 
                                event_callbacks => [],

                                traits => [   TEXT "OK",
                                             WIDTH button_width, 
                                             FONT button_font, 
                                             CALLBACK (make_simple_callback (fn()=> close_subst (window, wid,
                                                          length subst); end ))
                                         ]
                            },

                            BUTTON {
                                widget_id       => make_widget_id (),
                                packing_hints   => [PACK_AT LEFT],
                                event_callbacks => [],
                                traits          => [   TEXT "Cancel",
                                                      WIDTH button_width, 
                                                      FONT button_font,
                                                      CALLBACK (make_simple_callback (fn()= close_window window))
                                                  ]
                            }
                        ]
                };

            #  initializiation function 
            fun fill_subst wid (n, (p, str))
                = 
                {   insert_text_end (lhs_wid_id (wid, n)) p;
                    insert_text_end (rhs_wid_id (wid, n)) str
                ;};
                                                                                my
            window = make_window_id ();                                         my
            wid = make_widget_id ();      

          
            open_window (
                make_window {
                    window_id   => window,
                    traits      => [WINDOW_TITLE wintitle],
                    event_callbacks => [],
                    subwidgets  => PACKED [subst_frame (window, wid),
                                                 button_frm (window, wid)],
                    init     => (fn ()=> apply (fill_subst wid) (zip_it subst); end )
                }
            );
        };


    fun new { title, params, width, cc }
        = 
        do_subst (width,  " |-> ", title, map (fn str = (str, "")) params, cc);
                 
    fun edit { title, subst, width, cc }
        =
        do_subst (width,  " |-> ", title, subst, cc);

};


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext