# Compiled by:
# src/lib/tk/src/tk.sublib#
# Project: sml/Tk: an Tk Toolkit for sml
# Author: Burkhart Wolff, University of Bremen
# Date: 25.7.95
# Purpose of this file: Functions related to Path-Management
#
# ***********************************************************************
# To enhance efficiency, the GUI data package contains an association
# list from widget-id's to their internal paths. The internal path is a
# pair of the window-id of the window that contains the widget, and the
# widget-part of the path, i.e., the path without the window name.
#
# Tcl/Tk, on the other hand, regards windows and widgets the same,
# except for the main window which has name ".". So here we need
# conversion from the internal path to the Tcl path.
### "To stimulate creativity, one must develop
### the childlike inclination for play and
### the childlike desire for recognition."
###
### -- Albert Einstein
package paths
: (weak) Paths # Paths is from src/lib/tk/src/paths.api{
include package basic_tk_types;
include package gui_state;
include package basic_utilities;
# fun fstWidPath "" = ("", "")
fun fst_wid_path s
=
{ my (m1, m2) = substring::split_off_prefix (not o string_util::is_dot)
(substring::drop_first 1 (substring::from_string s));
(substring::string m1, substring::string m2);
};
fun last_wid_path p
=
{ my (rp, rw) = substring::split_off_suffix (not o string_util::is_dot)
(substring::from_string p);
if ((substring::size rp)== 0)
("", substring::string rw);
else
(substring::string (substring::drop_last 1 rp), substring::string rw);
fi;
};
fun occurs_window_gui w
=
list::exists (eq w) (map get_window_id (gui_state::get_windows_gui()));
fun occurs_widget_gui w
=
list::exists (eq w) (map fst (gui_state::get_path_ass_gui()));
fun add_widget wid winid path ass
=
ass @ [(wid, (winid, path))];
# gwp . Widget_ID -> [PathAss] -> Widget_Path
/*
fun gwp w ass = snd (gip w ass);
*/
# DelWidPaths . Widget_ID -> [PathAss] -> [PathAss]
# fun delWidPaths w ass =
# let p = gwp w ass
# in filter ((prefix p) o snd o snd) ass end;
fun delete_widget w ass
=
list::filter ( (\\ x => not (x == w); end ) o fst) ass;
fun delete_widget_path (wi, wp) ass
=
list::filter ( (\\ (x, y) = not (x==wi and y==wp)) o snd) ass;
fun delete_window w ass
=
list::filter ((\\ x = not (x == w)) o fst o snd) ass;
fun get_tcl_path_gui (w, p)
=
if (gui_state::is_init_window w) p;
else ("." + w + p);
fi;
# gip: Widget_ID -> [PathAss] -> IntPath
#
fun gip widget_id ((x, y) . ass) => if (widget_id == x) y; else gip widget_id ass; fi;
gip widget_id _ => raise exception WIDGET ("Error in function gip: Widget_ID " + widget_id + " undeclared.");
end;
# getIntPath . Widget_ID -> GUI s -> (IntPath, GUI s)
# "assoc"; search in the assoc-list
fun get_int_path_gui w
=
gip w (gui_state::get_path_ass_gui());
fun get_wid_path_gui wid
=
snd (get_int_path_gui (wid));
fun get_int_path_from_tcl_path_gui tp
=
{
my (front, r) = last_wid_path tp;
my (front2, r2) = last_wid_path front;
wid = if (r=="txt" and occurs_widget_gui r2) r2;
elif (r=="cnv" and occurs_widget_gui r2) r2;
elif (r=="box" and occurs_widget_gui r2) r2;
else r;
fi;
(fst (get_int_path_gui wid), wid);
};
# ************************************************************************
#
# Anonymous Widget_ID Manager
# Purpose: Creates anonymous names for widgets, starting with "anowid"
# And a unique number.
#
# ************************************************************************
my
anowid_nr = REF (0);
fun make_widget_id ()
=
{ inc (anowid_nr);
"anowid" + int::to_string *anowid_nr;
};
};