PreviousUpNext

15.4.1307  src/lib/tk/src/widget_ops.pkg

/* ***********************************************************************

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

   Project: sml/Tk: an Tk Toolkit for sml
   Author: Stefan Westmeier, University of Bremen
  $Date: 2001/03/30 13:39:22 $
  $Revision: 3.0 $
   Purpose of this file: Operations on Widgets Contents

   *********************************************************************** */

package   widget_ops
: (weak)  Widget_Ops                    # Widget_Ops    is from   src/lib/tk/src/widget_ops.api
{
        include basic_tk_types;
        include basic_utilities; 


        # get_marked_text has to look for
        # the actual text in case of an 
        # TEXT_ENTRY- TEXT_WIDGET or LIST_BOX widget
        #
        fun get_marked_text wid (m1, m2) = 
            { 
                gvf = com::read_tcl_val;
                ip =  paths::get_int_path_gui wid;
                w  =  widget_tree::get_widget_guipath ip;
             
                case w
                  
                    TEXT_ENTRY _   => 
                        gvf((paths::get_tcl_path_gui ip) + " get");

                   # Absolute Notloesung. Unklar wie man Selektionen findet !!! 
                   TEXT_WIDGET _ => 
                        { com::put_line (com::write_mto_tcl + " [" + (paths::get_tcl_path_gui ip)  +  
                                      ".txt get " + (mark::show m1) + " " +
                                      (mark::show m2) + "]") ;
                         com::get_line_m();};

                   LIST_BOX _ => 
                        { 
                            my (mt1, _)=string_util::break_at_dot (mark::show m1);
                            my (mt2, _)=string_util::break_at_dot (mark::show m2);
                          
                            gvf((paths::get_tcl_path_gui ip) + ".box get " + mt1 + " " + mt2);
                        };
                   _  => config::get_livetext_text w;
                esac;
            };

        fun get_text wid = get_marked_text wid (MARK (0, 0), MARK_END);


        fun get_widget_selections wid =
            { 
                gvf = com::read_tcl_val;
                ip =  paths::get_int_path_gui wid;
                w  =  widget_tree::get_widget_guipath ip;
                fun make_mark str = 
                    { my (x, y)= string_util::break_at_dot str;
                      MARK (string_util::to_int x, string_util::to_int y);
                    };  
                fun group []  => []; 
                   group (a . [])   => [];  #  hmmm ... ? 
                   group (a . b . s) => (a, b) . group (s); end; 
             
                case w   
                    TEXT_WIDGET _ => 
                        {
                            s = gvf((paths::get_tcl_path_gui ip) + ".txt tag ranges sel");
                        
                            group (map make_mark (string_util::words s));
                        };
                   LIST_BOX _ => 
                         { 
                             t = gvf((paths::get_tcl_path_gui ip) + ".box curselection");
                           
                             if (t=="" ) 
                                 [];
                             else 
                                 [(MARK (string_util::to_int t, 0), MARK_END)];fi;
                         };
                  #  TEXT_ENTRY ????????? 
                   _            => []; esac;
            };


        fun get_selection_window_and_widget ()
            = 
            { 
                gvf = com::read_tcl_val;
                t   = gvf("selection own");
              
                if (t == "" ) NULL; else THE (paths::get_int_path_from_tcl_path_gui t);fi;
            };


        # get_cursor_mark has to look for the actual cursor position in Listboxes  
        # And TextWidgets 

        fun get_cursor_mark wid
            =
            { 
                gvf = com::read_tcl_val;
                ip  = paths::get_int_path_gui wid;
                w   = widget_tree::get_widget_guipath ip;
             
                case w

                     TEXT_WIDGET _
                     => 
                     { 
                         t = gvf((paths::get_tcl_path_gui ip) + ".txt index insert");
                         my (m1, m2)= string_util::break_at_dot t;
                      
                         MARK (string_util::to_int m1, string_util::to_int m2); 
                     };

                   LIST_BOX _
                    =>
                    {
                        t = gvf((paths::get_tcl_path_gui ip) + ".box curselection");

    #                   debug::print 2 ("SelectCursor: t= >" + t + "<") 
                    
                        if ( t == "" )  raise exception WIDGET "widget_ops::get_cursor_mark: no selection";
                                      else MARK (null_or::the_else (int::from_string t, 0), 0);fi;
                    };

                   _              #  TEXT_ENTRY ????????? 
                    => 
                    MARK (0, 0); esac;
            };


        fun get_tcl_text_widget_read_only_flag wid
            =
            { 
                widg = widget_tree::get_widget_gui wid;
                tp   = (paths::get_tcl_path_gui o paths::get_int_path_gui) wid;

            
                if  ((get_widget_type widg) == TEXT_WIDGET_TYPE)
                    
                    case (com::read_tcl_val (tp + ".txt cget -state"))
                      
                        "normal"   => FALSE; #  TextWidStateNormal 
                        "disabled" => TRUE;  #  TextWidStateDisabled 
                    esac;
                else
                    raise exception WIDGET "widget_ops::get_tcl_text_widget_read_only_flag: applied to non-text_widget";
                fi;
            };

        fun set_tcl_text_widget_read_only_flag wid st
            =
            { 
                widg = widget_tree::get_widget_gui wid;
                tp   = (paths::get_tcl_path_gui o paths::get_int_path_gui) wid;
            
                if ( (get_widget_type widg) == TEXT_WIDGET_TYPE ) 
                    com::put_tcl_cmd (tp + ".txt configure -state " + (config::show_state st));
                else
                    raise exception WIDGET "widget_ops::setTextWidState: applied to non-text_widget";fi;
            };

        /* wrapper for functions doing things to text widgets: if it is read-only
         * we need to temporarily make it writable, otherwise nothing happens
         * (and the programmer is mightily confused).
         */
        fun do_text_wid f wid
            =
            { old_st = get_tcl_text_widget_read_only_flag wid;
            
                set_tcl_text_widget_read_only_flag wid FALSE;
                f wid;
                if old_st  set_tcl_text_widget_read_only_flag wid old_st; fi; 
            };


        fun clear_livetext wid
            =
            {
                widg  = widget_tree::get_widget_gui wid;
                anl   = live_text::get_livetext_text_items (text_item::get_text_widget_livetext widg);
            
                do_text_wid (fn w=> { apply (fn an => text_item_tree::delete w 
                                        (text_item::get_text_item_id an); end ) anl;
                                   widget_tree::clear_text w;}; end ) wid;
            };

        fun replace_livetext wid ats
            =
            { clear_livetext wid;
             do_text_wid (fn w=> { widget_tree::set_text_end w (live_text::get_livetext_text ats);
                                apply (fn an => text_item_tree::add w an; end )
                                    (live_text::get_livetext_text_items ats);}; end ) wid;};

        fun delete_marked_livetext wid marks =
            #  TBD: delete text_items as well !! 
            do_text_wid (fn w=> widget_tree::delete_text w marks; end ) wid;

        #  insert annotated text into text widgets 
        fun ins_at wid at (r, c) =
            { str   = live_text::get_livetext_text at;
                #  have to adjust text_items of the AT we want to insert 
                annos = live_text::adjust_marks { rows=>r, cols=>c } 
                                                      (live_text::get_livetext_text_items at);
              do_text_wid (fn w=> { widget_tree::set_text w str (MARK (r, c));
                                   apply (text_item_tree::add w) annos;}; end ) wid;
            };

        fun insert_livetext_at_mark wid at (MARK (r, c))
            =>
            ins_at wid at (r, c);

           insert_livetext_at_mark wid at (MARK_TO_END r)
            =>
            ins_at wid at (r, 0); #  WRONG! 

           insert_livetext_at_mark wid at (MARK_END)
            => 
            /* Very inefficient as it counts the length of the whole text-- yuck:
             */
            { my (r, c)= live_text::livetext_length (get_text wid);
             
                ins_at wid at (r, c);
            }; end;

        fun append_livetext wid at
            =
            insert_livetext_at_mark wid at MARK_END;


        #  No check that this variable is really defined!!! 

        fun get_var_value var
            = 
            com::read_tcl_val("global " + var + "; set " + var);


        fun set_var_value var value
            = 
            ignore (com::read_tcl_val("global " + var + "; set " + var + " " + value));


        fun make_and_pop_up_window widg index co
            =
            {
                winid = paths::make_widget_id();
                frmid = paths::make_widget_id();
                frm   = FRAME {
                                widget_id => frmid,
                                subwidgets => PACKED [widg],
                                packing_hints => [],
                                traits => [],
                                event_callbacks => []
                            }; 
                wid   = get_widget_id widg;
            
                window::open_w (winid, [], PACKED [frm], [], fn()=> (); end );
                widget_tree::pop_up_menu wid index co;
            };

        fun set_scale_value wid r
            =
            { widg = widget_tree::get_widget_gui wid;
                tp   = (paths::get_tcl_path_gui o paths::get_int_path_gui) wid;
            
                com::put_tcl_cmd (tp + " set " + config::show_real r);
            };

    };








Comments and suggestions to: bugs@mythryl.org

PreviousUpNext