PreviousUpNext

15.4.1492  src/lib/x-kit/widget/old/fancy/graphviz/text/show-graph.pkg

## show-graph.pkg
#
# A graph-viewer widget for ML code.

# Compiled by:
#     src/lib/x-kit/widget/xkit-widget.sublib

stipulate
    include package   threadkit;                        # threadkit             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package xc  =  xclient;                             # xclient               is from   src/lib/x-kit/xclient/xclient.pkg
    #
    package fil =  file__premicrothread;                # file__premicrothread  is from   src/lib/std/src/posix/file--premicrothread.pkg
    package lw  =  line_of_widgets;                     # line_of_widgets       is from   src/lib/x-kit/widget/old/layout/line-of-widgets.pkg
    package pb  =  pushbuttons;                         # pushbuttons           is from   src/lib/x-kit/widget/old/leaf/pushbuttons.pkg
    #
    package v   =  ml_source_code_viewer;               # ml_source_code_viewer is from   src/lib/x-kit/widget/old/fancy/graphviz/text/ml-source-code-viewer.pkg
    #
    package load = load_file_g( fil );                  # load_file_g           is from   src/lib/x-kit/widget/old/fancy/graphviz/text/load-file-g.pkg
    #
    package xtr =  xlogger;                             # xlogger               is from   src/lib/x-kit/xclient/src/stuff/xlogger.pkg
herein

    package show_graph:  Show_Graph {                   # Show_Graph            is from   src/lib/x-kit/widget/old/fancy/graphviz/text/show-graph.api


        fun open_viewer root_window { file, module, loc, range }
            =
            {

                # my _ = cio::print (format::format "open_viewer: file = %s, module = %s, loc = %d\n" [
                # format::STR file, format::STR module, format::INT loc])

                oneshot = make_oneshot_maildrop ();

                xtr::make_thread "ml_viewer open_viewer" {.
                    #
                    put_in_oneshot (oneshot, load::load_file (file, range));
                };

                stipulate
                    find_else_open_font = xc::find_else_open_font  (widget::xsession_of root_window);
                herein
                    font1 =  find_else_open_font "-*-courier-medium-r-*-*-20-*-*-*-*-*-*-*";
                    font2 =  find_else_open_font "-*-courier-medium-o-*-*-20-*-*-*-*-*-*-*";
                    font3 =  find_else_open_font "-*-courier-bold-r-*-*-20-*-*-*-*-*-*-*";
                end;

                viewer =    ml_source_code_viewer::make_viewer  root_window
                              {
                                src  =>  get_from_oneshot  oneshot,
                                font =>  font1,
                                #
                                background => xc::CMS_NAME "wheat1",
                                #
                                comm_face  => v::FACE { font=>THE font2, color => THE (xc::CMS_NAME "red"  ) },
                                kw_face    => v::FACE { font=>THE font3, color => THE (xc::CMS_NAME "black") },
                                sym_face   => v::FACE { font=>THE font3, color => THE (xc::CMS_NAME "black") },
                                id_face    => v::FACE { font=>NULL,      color => THE (xc::CMS_NAME "blue" ) }
                              };

                init_loc =  case range
                                NULL                =>  loc - 1;
                                THE { first, last } =>  loc - first;
                            esac;

                (widget::filter_other (scroll_viewer::make_viewer root_window (viewer, init_loc)))
                    ->
                    (widget, mailop);

                quit_btn =  pb::make_text_pushbutton  root_window
                              {
                                rounded    =>  TRUE,
                                label      =>  "Close view",

                                background =>  NULL,
                                foreground =>  NULL
                              };

                widget' =   lw::as_widget
                                (lw::make_line_of_widgets  root_window
                                    (lw::VT_CENTER
                                      [
                                        lw::HZ_CENTER
                                          [
                                            lw::SPACER { min_size=>2,  best_size=>2, max_size=>THE 2 },
                                            lw::VT_CENTER
                                              [
                                                lw::SPACER { min_size=>2,  best_size=>2, max_size=>THE 2 },
                                                lw::WIDGET (pb::as_widget quit_btn),
                                                lw::SPACER { min_size=>2,  best_size=>2, max_size=>THE 2 }
                                              ],
                                            lw::SPACER { min_size=>1,  best_size=>1000, max_size=>NULL }
                                          ],
                                        lw::WIDGET (divider::make_horizontal_divider  root_window  { color=>NULL, width=>1 } ),
                                        lw::WIDGET widget
                                      ]
                                    )
                                );

                hostwindow
                    =
                    hostwindow::make_hostwindow
                        ( widget',
                          NULL,
                          { window_name =>  THE ("ML-viewer: " + file),
                            icon_name   =>  THE "ML-viewer"
                          }
                        );

                fun cmd_monitor ()
                    =
                    loop ()
                    where
                        (block_until_mailop_fires  mailop)
                            ->
                            (cmd', cmd_slot);

                        quit' =   pb::button_transition'_of  quit_btn;


                        fun do_cmd  envelope
                            =
                            {    case (xc::get_contents_of_envelope  envelope)
                                     #  
                                     xc::ETC_OWN_DEATH =>  hostwindow::destroy hostwindow;
                                     _                 =>  ();
                                 esac;

                                 put_in_mailslot (cmd_slot, envelope);
                            };


                        fun do_quit (pb::BUTTON_UP _) =>  hostwindow::destroy hostwindow;
                            do_quit _                 =>  ();
                        end;


                        fun loop ()
                            =
                            for (;;) { 
                                #
                                do_one_mailop [
                                    #
                                    cmd'  ==>  do_cmd,
                                    quit' ==>  do_quit
                                ];
                            };

                    end;

                  hostwindow::start_widgettree_running_in_hostwindow  hostwindow;

                  xtr::make_thread  "ml_viewer"  cmd_monitor;

                  ();
              };                        # fun open_viewer

    };                          # package show_graph
end;



Comments and suggestions to: bugs@mythryl.org

PreviousUpNext