Personal tools
You are here: Home Projects SETL SETL2 Source code atkw_class_w_test.stl
Document Actions

atkw_class_w_test.stl

by Paul McJones last modified 2021-02-25 11:15

"Syntactic and semantic conventions for the SETL widget class", with test.

package Tk_interp_holder;			-- small auxiliary package for holding TK interpreter object
	var interp;					-- the master tk interpreter
end Tk_interp_holder;
 
package body Tk_interp_holder;			-- small auxiliary package for holding TK interpreter object
end Tk_interp_holder;

package doubleclick_pak;		-- doubleclick timing package for Tk
	procedure doubleclikk(the_Tk,proc);	-- wrapper procedure for doubleclick, non-canvas items
	procedure canvas_doubleclikk(the_Tk,proc);	-- wrapper procedure for doubleclick, canvas items
end doubleclick_pak;

package Tk_defaults;			-- defaults for Tk attribute values
	
	var Tk_children,Tk_packed,Tk_gridded,Tk_placed,Tk_config_data,Tk_binding_tags;
	var Tk_bindings,Tk_binding_responses,Tk_canvas_objs,Tk_text_objs,Tk_canvas_objs_data;
	var Tk_canvas_tags_bindings,Tk_canvas_binding_responses;
	var Tk_text_tags,Tk_text_tags_bindings,Tk_text_binding_responses,Tk_text_tags_data;
 	var new_item_from_orig_name;		-- global used in rebuild process
 					-- major global information mappings and sets for persistency system
	
	const Tk_pack_defaults := {["padx", "0"], ["anchor", "center"], ["ipadx", "0"], ["expand", "0"], 
								["fill", "none"], ["pady", "0"], ["ipady", "0"]};
	const Tk_grid_defaults := {["padx", "0"], ["ipadx", "0"], ["pady", "0"], ["ipady", "0"], 
				 				["rowspan", "1"], ["columnspan", "1"]};
	const Tk_place_defaults := {["relx", "0"], ["rely", "0"], ["anchor", "nw"]};

	const Tk_button_defaults := {["anchor", "center"], ["activebackground", "systemButtonText"], ["bitmap", ""],
	 	["default", "disabled"], ["foreground", "systemButtonText"], ["height",0], ["underline", "-1"],
	 	["width", "0"], ["wraplength", "0"], ["bd", "borderWidth"], ["background", "systemButtonFace"],
	  	["activeforeground", "systemButtonFace"], ["image", ""], ["command", ""], ["textvariable", ""],
	   	["manager", "pack"], ["state", "normal"], ["font", "system"],
	    ["highlightbackground", "systemWindowBody"], ["cursor", ""], ["relief", "flat"], ["pady", "3"],
	    ["borderwidth", "2"], ["children", []], ["takefocus", ""], ["height", "0"], ["ismapped", 0],
	  	["disabledforeground", "#a3a3a3"], ["highlightthickness", "4"], ["showing", "0"], ["manager", "pack"], 
	   	["highlightcolor", "systemButtonFrame"], ["justify", "center"], ["padx", "7"], ["Tk_tags", ["Button", ".", "all"]]};

	const Tk_canvas_defaults := {["highlightthickness", "3"], ["selectbackground", "systemHighlight"],
	 	["xscrollcommand", ""], ["yscrollcommand", ""], ["yscrollincrement", "0"], ["xscrollincrement", "0"],
	   	["ismapped", 0], ["confine", "1"], ["insertborderwidth", "0"], ["closeenough", "1.0"], 
	   	["borderwidth", "0"], ["bd", "borderWidth"], ["insertofftime", "300"], ["insertontime", "600"], 
	   	["highlightcolor", "Black"], ["manager", "pack"], ["selectborderwidth", "1"], ["manager", "pack"], 
		["background", "systemWindowBody"], ["highlightbackground", "systemWindowBody"], ["cursor", ""], 
		["relief", "flat"], ["insertwidth", "2"], ["scrollregion", ""], ["selectbackground", "systemHighlight"], 
		["children", []], ["takefocus", ""], ["showing", "0"], ["selectforeground", "Black"], ["insertbackground", "Black"],
		["Tk_tags", ["Canvas", ".", "all"]]};

	const Tk_frame_defaults := {["colormap", ""], ["ismapped", 0], ["borderwidth", "0"], ["visual", ""], ["bd", "borderWidth"], 
		["highlightcolor", "Black"], ["manager", "pack"], ["background", "systemWindowBody"], ["manager", "pack"],  
		["highlightbackground", "systemWindowBody"], ["container", "0"], ["cursor", ""], ["relief", "flat"], ["class", "Frame"], 
		["takefocus", "0"], ["highlightthickness", "0"], ["showing", "0"],["Tk_tags", ["Frame", ".", "all"]]};

	const Tk_toplevel_defaults := {["colormap", ""], ["height", "0"], ["class", "Tk"], ["width", "0"], ["borderwidth", "0"],
	 	["visual", ""], ["bd", "borderWidth"], ["use", ""], ["menu", ""], ["ismapped", 1], ["highlightcolor", "Black"], 
			["background", "systemWindowBody"], ["highlightbackground", "systemWindowBody"], ["container", "0"], ["cursor", ""], 
			["relief", "flat"], ["showing", "1"], ["screen", ""], ["takefocus", "0"], ["highlightthickness", "0"],
				["manager", "wm"],["Tk_tags", [".", "Tk", "all"]]};

	const Tk_message_defaults := {["anchor", "center"], ["aspect", "150"], ["ismapped", 0], ["width", "0"], 
			["bd", "borderWidth"], ["textvariable", ""], ["highlightcolor", "Black"], ["manager", "pack"], 
			["font", "system"], ["background", "systemWindowBody"], ["justify", "left"], 
			["highlightbackground", "systemWindowBody"], ["cursor", ""], ["relief", "flat"],  
			["pady", "3"], ["borderwidth", "2"], ["padx", "6"], ["children", []], ["takefocus", "0"], 
			["highlightthickness", "0"], ["showing", "0"], ["foreground", "Black"], ["Tk_tags", ["Message", ".", "all"]]};

	const Tk_label_defaults := {["anchor", "center"], ["bitmap", ""], ["foreground", "systemButtonText"], 
			["height", "0"], ["ismapped", 0], ["underline", "-1"], ["pady", "1"], ["width", "0"], ["manager", "pack"], 
			["wraplength", "0"], ["bd", "borderWidth"], ["background", "systemButtonFace"], ["image", ""], 
			["textvariable", ""], ["padx", "1"], ["font", "system"], ["highlightbackground", "systemWindowBody"], 
			["cursor", ""], ["relief", "flat"], ["manager", "grid"], ["borderwidth", "2"],  ["children", []],
	 		["takefocus", "0"], ["highlightthickness", "0"], ["showing", "0"], ["highlightcolor", "systemButtonFrame"], 
	  		["justify", "center"], ["Tk_tags", ["Label", ".", "all"]]};

	const Tk_menubutton_defaults := {["anchor", "center"], ["bitmap", ""], ["manager", "pack"],
 			["height", "0"], ["ismapped", 0], ["underline", "-1"], ["width", "0"], ["wraplength", "0"], ["padx", "4"],
 			["bd", "borderWidth"],  ["image", ""], ["textvariable", ""], ["highlightcolor", "Black"], 
			["state", "normal"], ["font", "system"], ["direction", "below"], ["background", "systemWindowBody"], 
			["justify", "left"], ["highlightbackground", "systemWindowBody"], ["cursor", ""], ["relief", "flat"], 
 			["manager", "grid"], ["pady", "3"], ["borderwidth", "2"],
 			["indicatoron", "0"], ["children", []], ["takefocus", "0"], ["highlightthickness", "0"], 
 			["disabledforeground", "#a3a3a3"], ["activebackground", "#ececec"], ["showing", "0"], 
 			["activeforeground", "Black"], ["foreground", "Black"],["Tk_tags", ["Menubutton", ".", "all"]]};

	const Tk_menuitem_defaults := {["activebackground","{} {} {} {}"], ["activeforeground","{} {} {} {}"], 
		["accelerator","{} {} {} {}"], ["background","{} {} {} {}"], ["bitmap","{} {} {} {}"], ["columnbreak","{} {} 0 0"], 
		["command","{} {} {} {}"], ["font","{} {} {} {}"], ["foreground","{} {} {} {}"], ["hidemargin","{} {} 0 0"], 
		["image","{} {} {} {}"],["underline", "{} {} -1 -1"], ["state", "{} {} normal normal"]};

	const Tk_menu_defaults := {["activeforeground", "SystemMenuActiveText"], ["foreground", "SystemMenuText"], 
			["disabledforeground", "SystemMenuDisabled"], ["tearoffcommand", ""], 
			["postcommand", ""], ["activeborderwidth", "0"], ["borderwidth", "0"], ["bd", "borderWidth"], 
			["activebackground", "SystemMenuActive"], ["background", "SystemMenu"], ["title", ""], 
			["cursor", "arrow"], ["type", "normal"], ["font", "system"], 
			["relief", "flat"], ["tearoff", "0"], ["children", []], ["takefocus", "0"], ["wincoords", [0, 0]], 
			["selectcolor", "SystemMenuActive"], ["showing", "0"],["rect", [0, 0, 1, 1]], 
			["ismapped", 0], ["manager", "wm"], ["Tk_tags", ["Menu", "all"]]};

	const Tk_text_defaults := {["highlightthickness", "3"], ["selectforeground", "systemHighlightText"], 
		["selectbackground", "systemHighlight"], ["xscrollcommand", ""], ["yscrollcommand", ""], ["setgrid", "0"], 
		["ismapped", 0], ["pady", "1"], ["insertborderwidth", "0"], ["borderwidth", "0"], 
		["bd", "borderWidth"], ["spacing1", "0"], ["insertofftime", "300"], ["insertontime", "600"], ["padx", "1"], 
		["highlightcolor", "Black"], ["selectborderwidth", "1"], ["state", "normal"], ["insertwidth", "1"], 
		["background", "systemWindowBody"], ["highlightbackground", "systemWindowBody"], ["wrap", "char"], 
		["spacing2", "0"], ["relief", "flat"], ["font", "Courier 12"], 
		["children", []], ["tabs", ""], ["takefocus", ""], ["spacing3", "0"], ["showing", "0"], 
		["exportselection", "1"], ["cursor", "xterm"], ["foreground", "Black"], ["insertbackground", "Black"], 
		["manager", "pack"],["Tk_tags", ["Text", ".", "all"]]};

	const Tk_text_tag_data_defaults := {["wrap", ""], ["background", ""], ["offset", ""], ["borderwidth", ""], 
		["lmargin1", ""], ["spacing1", ""], ["overstrike", ""], ["fgstipple", ""], ["bgstipple", ""], 
		["underline", ""], ["justify", ""], ["lmargin2", ""], ["spacing2", ""], ["relief", ""], 
		["rmargin", ""], ["tabs", ""], ["spacing3", ""], ["foreground", ""], ["font", ""]};

	const Tk_entry_defaults := {["selectforeground", "systemHighlightText"], ["selectbackground", "systemHighlight"], 
		["xscrollcommand", ""], ["ismapped", 0], ["insertborderwidth", "0"], ["bd", "borderWidth"], 
		["insertofftime", "300"], ["insertontime", "600"], ["textvariable", ""], ["highlightcolor", "Black"], ["manager", "pack"], 
		["selectborderwidth", "1"], ["state", "normal"], ["insertwidth", "1"], ["borderwidth", "1"], ["background", "systemWindowBody"], 
		["justify", "left"], ["highlightbackground", "systemWindowBody"], ["relief", "solid"], ["font", "Helvetica 12"], 
		["children", []], ["takefocus", ""], ["highlightthickness", "0"], ["show", ""], ["showing", "0"], 
		["exportselection", "1"], ["cursor", "xterm"], ["foreground", "Black"], ["insertbackground", "Black"],
		["Tk_tags", ["Entry", ".", "all"]]};

	const Tk_listbox_defaults := {["width", "8"], ["yscrollcommand", ".w1.w9 set"], ["selectforeground", "systemHighlightText"], 
		["selectbackground", "systemHighlight"], ["selectmode", "browse"], ["xscrollcommand", ""], ["manager", "pack"], 
		["setgrid", "0"], ["ismapped", 0], ["selectborderwidth", "0"], ["bd", "borderWidth"], ["highlightcolor", "Black"], 
		["manager", "pack"], ["borderwidth", "1"], ["background", "systemWindowBody"], ["highlightbackground", "systemWindowBody"], 
		["cursor", ""], ["relief", "solid"], ["font", "application"], ["children", []], ["takefocus", ""],  
		["highlightthickness", "0"], ["showing", "0"], ["exportselection", "1"], ["foreground", "Black"],
		["Tk_tags", ["Listbox", ".", "all"]]}; 
	
	const Tk_scrollbar_defaults := {["jump", "0"], ["ismapped", 0], ["manager", "pack"], 
		["orient", "vertical"], ["borderwidth", "0"], ["repeatinterval", "100"], ["bd", "borderWidth"], ["troughcolor", "#c3c3c3"],  
		["highlightcolor", "Black"], ["manager", "pack"], ["repeatdelay", "300"], ["elementborderwidth", "-1"], 
		["background", "systemWindowBody"], ["highlightbackground", "systemWindowBody"], ["cursor", ""], ["relief", "flat"], 
		["activerelief", "raised"], ["children", []], ["takefocus", ""], 
		["highlightthickness", "0"], ["activebackground", "#ececec"], ["showing", "0"],["Tk_tags", ["Scrollbar", ".", "all"]]};

	const Tk_scale_defaults := {["showvalue", "1"], ["ismapped", 0], ["command", ""], ["manager", "pack"],
	 	["bigincrement", "0.0"], ["width", "10"], ["orient", "horizontal"], ["label", ""], ["tickinterval", "0.0"], 
	 	["repeatinterval", "100"], ["bd", "borderWidth"], ["troughcolor", "#c3c3c3"], 
		["variable", ""], ["highlightcolor", "Black"],  ["state", "normal"], ["font", "system"],  
		["repeatdelay", "300"], ["background", "systemWindowBody"], ["highlightbackground", "systemWindowBody"], 
		["cursor", ""], ["relief", "flat"], ["sliderrelief", "raised"], ["borderwidth", "2"], 
		["resolution", "1.0"], ["children", []], ["takefocus", ""], ["digits", "0"], ["highlightthickness", "0"], 
		["activebackground", "#ececec"], ["showing", "0"], ["foreground", "Black"], ["Tk_tags", ["Scale", ".", "all"]]};

	const Tk_checkbutton_defaults := {["anchor", "center"], ["activebackground", "systemButtonText"], ["bitmap", ""],
	 	["foreground", "systemButtonText"],  ["height", "0"], ["ismapped", 0], ["manager", "pack"], 
	  	["underline", "-1"], ["offvalue", "r1"], ["pady", "1"], ["width", "0"], ["wraplength", "0"], ["bd", "borderWidth"], 
	  	["background", "systemButtonFace"], ["activeforeground", "systemButtonFace"], ["image", ""],  
	  	["selectimage", ""], ["textvariable", ""], ["padx", "1"], ["manager", "pack"], ["state", "normal"], ["font", "system"], 
	  	["highlightbackground", "systemWindowBody"],  ["selectcolor", "#b03060"], ["cursor", ""], ["relief", "flat"], 
	  	["borderwidth", "2"], ["children", []], ["takefocus", ""], 
	 	["disabledforeground", "#a3a3a3"], ["highlightthickness", "4"], ["showing", "0"], ["highlightcolor", "systemButtonFrame"],  
	  	["justify", "center"], ["indicatoron", "1"], ["Tk_tags", ["Checkbutton", ".", "all"]]};

	const Tk_radiobutton_defaults := {["anchor", "center"], ["activebackground", "systemButtonText"], ["bitmap", ""],
	 	["foreground", "systemButtonText"],["value", "Radio1"], ["height", "0"], ["manager", "pack"],
	 	["ismapped", 0], ["command", ""], ["underline", "-1"], ["pady", "1"], ["width", "0"], ["wraplength", "0"], 
	 	["bd", "borderWidth"], ["background", "systemButtonFace"], ["activeforeground", "systemButtonFace"], 
	 	["image", ""], ["selectimage", ""], ["textvariable", ""], ["padx", "1"], 
	 	["manager", "pack"], ["state", "normal"], ["font", "system"], ["highlightbackground", "systemWindowBody"], 
	 	["selectcolor", "#b03060"], ["cursor", ""], ["relief", "flat"], ["borderwidth", "2"],  
	 	["children", []], ["takefocus", ""], ["disabledforeground", "#a3a3a3"], ["highlightthickness", "4"], ["showing", "0"], 
	 	["highlightcolor", "systemButtonFrame"], ["justify", "center"], 
	 	["indicatoron", "1"], ["Tk_tags", ["Radiobutton", ".", "all"]]};

 	const Tk_oval_defaults :=  {["width", "1"], ["stipple", ""], ["outline", "black"], ["tags", []]};
  
	const Tk_rectangle_defaults := {};

	const Tk_arc_defaults := {["style", "pieslice"], ["width", "1"], ["outlinestipple", ""], ["stipple", ""], 
								["outline", "black"]};

	const Tk_line_defaults := {["smooth", "0"], ["tags", []], ["joinstyle", "round"], ["width", "1"],
		["splinesteps", "12"], ["capstyle", "butt"], ["stipple", ""], ["arrow", "none"], ["arrowshape", "8 10 3"], 
		["fill", "black"]};

	const Tk_polygon_defaults := {["smooth", "0"], ["width", "1"], ["splinesteps", "12"], ["outline", ""], 
				["stipple", ""], ["fill", ""], ["tags", []]};

	const Tk_canvaswidget_defaults := {["width", "0"], ["height", "0"], ["anchor", "nw"], ["tags", []]};

	const Tk_canvasimage_defaults := {["anchor", "nw"], ["tags", []]};

	const Tk_canvastext_defaults := {["width", "0"], ["justify", "left"], ["stipple", ""], ["tags", ["all"]],
		 ["fill", "black"], ["anchor", "nw"], ["tags", []]};

	const Tk_data_defaults := {["button",Tk_button_defaults],["canvas",Tk_canvas_defaults],["message",Tk_message_defaults],
		["label",Tk_label_defaults],["menubutton",Tk_menubutton_defaults],["frame",Tk_frame_defaults],
		["toplevel",Tk_toplevel_defaults],["menu",Tk_menu_defaults],
		["scale",Tk_scale_defaults],["checkbutton",Tk_checkbutton_defaults],["radiobutton",Tk_radiobutton_defaults],  
		["listbox",Tk_listbox_defaults],["scrollbar",Tk_scrollbar_defaults],["oval",Tk_oval_defaults],
		["rectangle",Tk_rectangle_defaults],["arc",Tk_arc_defaults],["line",Tk_line_defaults], 
		["polygon",Tk_polygon_defaults],["text",Tk_text_defaults],["entry",Tk_entry_defaults],
		["text_tag_data",Tk_text_tag_data_defaults],["menuitem_data",Tk_menuitem_defaults],
		["widget",Tk_canvaswidget_defaults],["image",Tk_canvasimage_defaults],["canvas_text",Tk_canvastext_defaults]};

 end Tk_defaults;
 
package body Tk_defaults;		-- defaults for Tk attribute values (dummy body, empty)
end Tk_defaults;

 class tkw;						-- tk widget class; alternative draft
	
	class var show_commands := false;		-- DEBUGGING SWITCH
	class var debug_trace;				-- global variable for tracing

	class var for_tk := OM;					-- for accumulating calls to Tk
	class var dialog_response;				-- for transmitting responses from standard dialogs
	class var prior_id := OM,numcanceled := 0;	-- global variables for doubleclick tracking
	class var namegen_ctr := 0;				-- counter for generating auxiliary Tk variables for storing server_socket associated callback procedures
	var socket_error;						-- instance variable,storing  error resulting from  read and write if  object is  a socket 
	
	const cursors_stg := 	"arrow,double_arrow,based_arrow_down,based_arrow_up,draft_large,draft_small," + 
					"top_left_arrow,right_ptr,center_ptr,right_side,left_side,bottom_side,top_side," + 
					"center_ptr,sh_h_double_arrow,sh_v_double_arrow,sh_left_arrow,sh_right_arrow," +
					"sh_up_arrow,sh_down_arrow,xterm," + 
					"x_cursor,plus,tcross,crosshair,spider,fleur,iron_cross,diamond_cross," + 
					"cross_reverse,cross,dot," + 
					"right_tee,left_tee,bottom_tee,top_tee," + 
					"ll_angle,lr_angle,ul_angle,ur_angle," + 
					"dotbox,draped_box,sizing,middlebutton,rightbutton,leftbutton,target," + 
					"box_spiral,icon,rtl_logo," +
					"bottom_left_corner,bottom_right_corner,top_left_corner,top_right_corner," +
					"exchange,mouse,spraycan,pencil,star,boat,bogosity,pirate,man,question_arrow," +
					"gobbler,gumby,hand1,hand2,heart,trek,clock,circle,coffee_mug,sailboat,umbrella," + 
					"watch,shuttle";
	class var doubleclick,canvas_doubleclick;	-- wrapper procedure for doubleclick; transmitted from preceding package 
						-- 'proc' should be a  1-parameter procedure,  which expects to  be passed the number of prior cancelled events

	procedure create();			-- creation of fundamental interpreter and empty objects
 	procedure do_all_calls();	-- transmit any accumulated calls to Tk, as single string;  then stop accumulating
 	procedure hold_calls();		-- start accumulating calls to Tk
 	
   	procedure Tk_id();			-- returns an object's (short) Tk name 
  	procedure Tk_kind();		-- returns an object's Tk type 
 	procedure Tk_break();		-- terminate event handling in the Tk sequence  
	procedure Tk_continue(); 	        -- jump  in event handling in the Tk sequence  

	procedure dooneevent(); 		    -- wait for some (any) Tk event

	procedure do_later(proc);	        -- execute a procedure after a short delay 
	procedure obj_from_tkname(tkname);	-- reconstruct a widget from its Tk name
	procedure tk_parent(); 				-- the parent object  of  an object
	procedure win_of_pt(x,y);			-- find the widget containing x,y

	procedure full_name();				-- finds full tk name string of widget PUBLIC FOR DEBUGGING ONLY
	procedure selfstr();				-- string conversion

	procedure beeper();					-- beep procedure; utility for SETL

	procedure stopper();				-- destruction of top level window to force return from Tk main loop

	procedure place();					-- returns object x and y coordinates if placed in parent
	procedure gridbox(i,j);				-- returns coordinates  of specified gridbox 
	procedure raise(after_obj);			-- raises object to position just after after_obj, or to top
	procedure lower(before_obj);		-- lowers object to position just before before_obj, or to bottom

	procedure createtimer(interval,SETL_fun);		-- create a timer callback (rings once)
	procedure cancel_event(id);		-- cancel a timer or idle callback
	procedure break_event();		-- suppress further processing of an  event

	-- ****** Operations available for all widgets ******

	procedure bindtags(tag);		-- gets event bindings for specified tag, or for whole widget if tag = OM
--	procedure virt_event_info(virt_event);		-- gets physical definition of specified virtual events, or virtual event list if param is OM [ Tk{"event",virt_event} ]
	procedure virt_event_delete(virt_event);		-- deletes specified virtual event
	
	-- ****** Canvas Operations ******

	procedure addtag_after(tag);		-- **OK** --the following group of routines 
								-- add a specified tag to the item just before (or after) that a 
								-- given object in the display list, or to all items, or to all enclosed in a given 
								-- rectangle, or to the nearest item to a given point, 
								-- or to items which already have a given tag or numerical identifier
	procedure addtag_before(tag);		 -- **OK**
	procedure addtag_in(tag,rect);		 -- **OK**
	 	-- add tag to all items in a rectangle, or to all items if rect is OM
	procedure addtag_nearest(tag,xy,halo,start);	-- nearest to x,y, or last within radius halo of x,y, or
										-- first such after item start in the canvas display list **OK**
	procedure addtag_if(newtag,hastag);		-- add new tag if already has a tag.  **OK**	
	procedure addtag(newtag);				-- add new tag to a canvas item 	 **OK**

	procedure bbox_tags(tags);			-- get bounding box of items with given tags **OK**
	procedure canvasx(x,roundto);		-- map from screen to canvas coordinates, possibly rounded to grid units **OK**
	procedure canvasy(y,roundto);		-- map from screen to canvas coordinates, possibly rounded to grid units **OK**
	procedure delete_items(tags_or_ids);	-- remove the item(s) identified  by a tag **OK**
	procedure delete();					-- delete a canvas item
	procedure delete_till(end_ci);	-- delete a range of canvas items
	procedure draw_ovals(descriptor_tup);	-- draw a group of ovals; called as ca.draw_ovals(descriptor_tup), ca must be canvas
									-- returns pair consisting of first and last ovals drawn

	procedure deltag(tags_or_ids);			-- remove the specified tags from a canvas item  **OK**		
	procedure deltag_if(iftag,tags_or_ids);	-- remove the specified tags from the item identified  by an id or tag  **OK**	

	procedure get_tagindex(tag,index);		-- gets the value of an index in a tagged canvas text item
	procedure get_select(tag);				-- gets the value of sel.first and  sel.last in a tagged canvas text item 
	procedure set_select(tag,i,j);			-- sets the value of sel.first and  sel.last in a tagged canvas text item 
	procedure refocus(tag);					-- sets the focus to a tagged canvas text item, or gets it if tag = OM 

	procedure find_after();		-- find all the items just above (or below) that with a given tag,  **OK**
								-- or to all items, or to all enclosed in a given rectangle, or to the 
								-- nearest item to a given point, or to items which already have a given tag or id	
	procedure find_before();	-- each of these routines returns a canvas object, identified by the serial number of   **OK**
	procedure find_in(rect);	-- the canvas item which it finds 	**OK**
	procedure find_touching(rect);	-- find all the items touching in a given rectangle **OK**
	procedure find_nearest(xy,halo,start);	-- **OK**
	procedure find(tag);			-- find all the items with a given tag **OK**
	
	procedure focus();			-- return widget in win which has the focus
	procedure focus_in_top();		-- return widget in same toplevel as win which has the focus
	procedure get_focus();		-- set focus to this window

	procedure read_grab();		-- determine the modal grab state of this window: none, local, or global
	procedure grabber();			-- return window which has exerted a grab

	procedure destroy();			-- destroy a widget 						**OK**

	procedure wait();			-- wait for this window to open
	procedure wait_close();		-- wait for this window to be destroyed

	
	-- ****** Canvas Widget Operations ******

--	procedure dchars(m,n);		-- delete characters m thru n of specified canvas text item  **OK** [textitem(m..n) := ""]
--	procedure insert_ct_item(m,stg);	-- insert specified string into canvas text item at position m  **OK** [textitem(m..n) := stg]
	procedure index_item(ix_key);	-- get numerical value of index_key, which can be active, end, last, etc. **OK**

	procedure lower_tid(tag_or_id,be);		-- lower the item identified by an id or tag either to  specified level,
						 		-- or to the start of the display list
	procedure raise_tid(tag_or_id,ab);		-- raise the item identified by an id or tag either to  speicified level,
								-- or to the end of the display list
	procedure move(tag_or_id,dx,dy);	-- move the item(s) identified  by an id or tag, a specified amount **OK**

	procedure postscript(options);	-- generate postscript for the contents of a canvas. See below for options available

	procedure scale_item(cent_x,cent_y,amt_x,amt_y); -- 						**OK**

								-- scale a canvas item by a specified amount about a specified center
	procedure scan_mark(x,y);	-- place mark indicating scroll position
	procedure scan_to(x,y);		-- scroll to indicated position
	procedure scan_mark_1(x);	-- place mark indicating scroll position
	procedure scan_to_1(x);		-- scroll to indicated position
	procedure canvas_select();	-- ???
	procedure xview_percent(p);	-- move to place fraction p of string offscreen to the left; p is real **OK**
	procedure xview_scroll(n,what);	-- scroll horizontally, n 'units' or 'pages'
	procedure yview_scroll(n,what);	-- scroll vertically, n 'units' or 'pages'
	procedure image_of(rect);	-- capture the contents of a rectangle within a canvas, as a Tk absolute image

	-- ****** Text Widget Operations ******

--	procedure bbox(n);			-- return bounding box of specified character
	procedure compare(op,ix1,ix2);	-- compare character indices in line.char and other allowed formats
	procedure debug(on_off);		-- enable  consistency checking for B-tree code???
--	procedure delete(m,n);		-- delete one character, or a range of characters	[text(m..n) := ""] 	**OK**
--	procedure get(m,n);			-- return range of characters  [text(m..n)] 						**OK**
	procedure insert_tt(n,chars_and_tags);			
							-- insert a substring; this can carry specified tags in designated subsections 	**OK**
	procedure linebox(n);		-- return bounding box and baseline of line n
	procedure insert_image(n,img); 	-- insert an image at a specified text position **OK**
--	procedure images();				-- return the ordered list of all images in the text widget	[txt("images")] **OK**
	procedure index(ix_stg);			-- return line.character position of specified text index 			**OK**
		-- text indices can be "current" (char under mouse), "end", "insert" (insert position),
		-- line.char, image (name), widget (name), mark (stg), tag_name.first, tag_name.last, 
	procedure mark_set(name,n);		-- place a named mark at the specified index					**OK**
	procedure mark_unset(name);		-- remove a named mark (can also be comma-separated list)

	procedure mark_gravity(name,n);	
		-- set the 'gravity' (left,right) of a mark, which determines the placement of strings inserted at the mark
	procedure mark_next(n);		-- return the first mark after text position n						**OK**
	procedure mark_prev(n);		-- return the last mark before text position n						**OK**
--	procedure scan_mark(x,y);		-- place mark indicating scroll position???
--	procedure scan_to(x,y);			-- scroll to indicated position
	procedure search(options,pattern,n,m);		-- string search; returns empty string if unsuccessful	**OK**
				-- search section of text from m to n for a pattern. 'options' parameter can be
				-- "forward", "backward", "nocase", (count - return count of matched characters in specified var)
				-- "exact", "regexp" (use regular expression matching)
				-- unless regular expression ,matching is specified, the 'pattern' is 
				-- only allowed to have "*" (wildcard), ? (one char), or [abc] specified chars
	procedure see(n);			-- scroll to make a given line.character position n visible

		-- text widget tag information is fetched/set by operations of the syntactic form 
		-- tw("tag","attribute,attribute,...") and tw("tag","attribute,attribute,...") := "val,val,..";

		-- to bind callback procedures to textfield tag events we use the syntax 

		--		textfield{"tag_name","event_descriptor,event_fields_signature"} := SETL_procedure;
		
		-- this is like all other binding syntax, but carries a tag name as an extra parameter

	procedure tag_add(tag,index_range_stg);		-- add tag to a list of character ranges		**OK** (possib. off by 1)
	procedure tag_remove(tag,index_range_stg);		-- remove tag from list of text ranges		**OK** (possib. off by 1)
--	procedure tag_delete(tag_list);			-- delete information for list of tags [txt("tags") := list;]	**OK**
	procedure tag_names(n);		-- return ordered list of tags at specified char position. OM gives all 	**OK**
--	procedure tag_lower(tag,below);	-- lower tag to specified position in priority list of tags, or to start [txt("tags") := list;]	**OK**
--	procedure tag_raise(tag,above);	-- raise tag to specified position in priority list of tags, or to end [txt("tags") := list;]	**OK**
	procedure tag_nextrange(tag,n,m);	-- search for first subrange of specified range that carries specified tag **OK**
	procedure tag_prevrange(tag,n,m);	-- search for last subrange of specified range that carries specified tag **OK**
	procedure tag_ranges(tag);			-- get list of all ranges for specified tag

	procedure insert_widget(n,wind);		-- insert an widget window at a specified text position	  **OK**
--	procedure widgets_in();		-- return the ordered list of all widgets in the text widget 	[txt("widgets")]  **OK**
--	procedure xview_percent(p);	-- move to place fraction p of string offscreen to the left; p is real	**OK**
--	procedure xview_scroll(n,what);	-- scroll horizontally, n 'units' or 'pages'
	procedure yview_percent(p);	-- move to place fraction p of string offscreen to the top; p is real
--	procedure yview_scroll(n,what);	-- scroll vertically, n 'units' or 'pages'

	-- ****** Button Operations ******

	procedure flash();			-- cause the button to flash 								**OK**
	procedure invoke_button();	-- trigger the button's action 									**OK**
--	procedure deselect();		-- deselect radio button or checkbutton		[button("selected") := 0;]	**OK**
--	procedure select_button();	-- select radio button or checkbutton		[button("selected") := 1;]		**OK**

	-- ****** Menu Operations ******

--	procedure activate(n);				-- highlight specified entry (zero based) [menu("active") := n;]
--	procedure add(the_type,options_values);	-- add entry of specified type with specified options	[menu(i..i - 1) := labels] **OK**
	procedure clone();					-- make linked copy of the menu (for tearoffs, etc.)
--	procedure delete(m,n);				-- delete entries from m to n	[menu(n..m) := ""] **OK**
--	procedure index(index_key);			-- get numerical value of index_key, which can be active, end, last, etc.
--	procedure insert(type,n,options);
		-- insert entry of specified type with specified options at position n	[menu(n..m) := labels]	**OK**
	procedure invoke(n);				-- trigger the entry's action 								**OK**
	procedure post(i,j);				-- display menu at specified coordinates
	procedure popup(i,j);				-- display menu at specified coordinates

	procedure postcascade(n);			-- display menu in hierarchical position for entry n
	procedure entry_type(n);			-- get the type of menu entry n 	[menu(n,"type")]
	procedure unpost();					-- hide the menu
	procedure yposition(n);				-- return vertical position of top of entry n
								
	-- ****** Scale Operations ******

	procedure coords(n);		-- transform scale value into geometric position 				**OK** 
	procedure get(ij);			-- get scale value, or value corresponding to given position
	procedure identify(ij);	-- return 'trough1' (left of slider), 'slider', or 'trough2 (right of slider)'	**OK**
--	procedure set_scale(n);		-- move the scale to indicated value 			**OK** [sc(OM) := n;]

	-- ****** Scrollbar Operations ******

	procedure activate(x);		-- query/set active element, which can be arrow1, arrow2, or slider
	procedure delta(dxy);		-- convert desired horizontal or vertical value change to slider units
	procedure fraction(x);		-- convert point position into fraction relative to scrollbar extent
--	procedure identify(i);		-- identify the scrollbar element (arrow1, arrow2, or slider) under point x,y

	-- ****** Entry Operations ******

	procedure bbox(n);			-- return bounding box of specified character 						**OK**
--	procedure delete(m,n);		-- delete characters from m to n 			[entry(m..n)] 			**OK**
--	procedure get(m,n);			-- return characters from m to n of string in the entry	[entry(m..n), #entry]
--	procedure index(index_key);	-- get numerical value of index_key, which can be anchor, end, insert, etc. **OK**
--	procedure insert(n,string);	-- insert string at indicated position		[entry(m..n) := stg] 		**OK**
--	procedure scan_mark(x);		-- place mark indicating scroll position???
--	procedure scan_to(x);			-- scroll to indicated position
	procedure select(m,n);		-- select characters m to n, or clear the selection 					**OK**
	procedure select_anchor(m);	-- set the anchor point for the selection
--	procedure xview_percent(p);	-- move to place fraction p of string offscreen to the left; p is real 	**OK**
--	procedure xview_scroll(n,what);	-- scroll horizontally, n 'units' or 'pages'

	-- ****** Listbox Operations ******
---> Working On these
--	procedure activate(n);		-- activate specified line			[listbox("active") := line;]
--	procedure bbox(n);			-- return bounding box of specified line							????
--	procedure curselection();		-- return list of selected lines	[listbox(OM)] 					**OK**
--	procedure delete(i,j);		-- delete indicated range of lines	[listbox(i..j) := ""] 			**OK**
--	procedure get(m,n);			-- return lines m thru n			[listbox(m..n)] 				**OK**
--	procedure index(index_key);	-- get numerical value of index_key, which can be anchor, end, insert, etc. **OK**
--	procedure insert(n,strings);	-- insert list of strings before indicated item	[listbox(m..m - 1) := lines] **OK**
	procedure nearest(y);			-- return index of line vertically nearest to y
--	procedure scan_mark(x);		-- place mark indicating scroll position???
--	procedure scan_to(x);			-- scroll to indicated position
--	procedure see(n);			-- adjust display to make line n visible
--	procedure select_anchor(m);	-- set the anchor line for the selection
--	procedure select(m,n);		-- select lines m to n, or clear the selection
	procedure is_select_line(m);	-- determine if line m is selected
--	procedure size();			-- number of elements in list 		[#listbox]						**OK**
--	procedure xview(n);			-- move to make character line visible, or read vertical scroll position
--	procedure xview_percent(p);	-- move to place fraction p of string offscreen to the left; p is real 	**OK**
--	procedure xview_scroll(n,what);	-- scroll horizontally, n 'units' or 'pages'
	procedure yview(n);			-- move to make indicated line visible, or read vertical scroll position
--	procedure yview_percent(p);	-- move to place fraction p of string offscreen to the top; p is real
--	procedure yview_scroll(n,what);	-- scroll vertically, n 'units' or 'pages'

	-- ****** Clipboard Operations ******

	procedure clear_selection(win,the_sel);			-- clear specified selection in specified window
	procedure get_selection(win,the_sel,the_type);		-- return the specified selection
	procedure handle_selection(win,the_type,format,the_sel,proc);
		-- define proc to be handler for set/the_type selection requests when 'win' is selection owner
	procedure own_selection(win,the_sel,proc);
		-- assert that win is sel owner; and that proc should be called when it loses ownership
	procedure selection_owner(win,the_sel);			-- find string name of current owner of selection 'sel'

	procedure clear_clipboard(win);					-- clear clipboard for specified window
	procedure addto_clipboard(win,the_type,format,data);	
			-- add 'data', of specified format and type, to clipboard for specified window

	-- ****** Dialogs and Message boxes ****** 
		-- Note: all these have been put in the syntax win("ask_...","options") := "option_vals";

	-- ****** Absolute Image Operations; see final comments for other image operations in SETL syntax ******

	procedure dither();				-- dither the image 							**OK**
	procedure write_im(file,options);	-- write image to file 						**OK**
	procedure copy_im(source,options);	-- copy one image to another 					**OK**
	procedure stuff_im(data,rect);		-- insert data into image rectangle				???

	-- ****** Window Manager Operations ******

	procedure win_close();					-- close or iconify a toplevel		
	procedure win_open();					-- open or deiconify a toplevel		
	procedure containing(x,y);		-- window containing given point
	procedure pixels(n);			-- number of pixels corresponding to given size in screen units
	procedure fpixels(n);			-- floating number of pixels corresponding to given size in screen units
	procedure rgb(color_name);		-- numerical code for named color
	procedure get_winfo_attr(att);			-- get an attribute available through the Tk 'winfo' primitives

	-- 						****** Rastport Operations ******

	procedure put_img(gr_img,x,y);	-- stuff gr_img into tkrport at position x, y
	procedure put_add(gr_img,x,y);	-- stuff gr_img into tkrport using 'sum'
	procedure put_dif(gr_img,x,y);	-- stuff gr_img into tkrport using 'dif'
	procedure put_mul(gr_img,x,y);	-- stuff gr_img into tkrport using 'mul'
	procedure put_div(gr_img,x,y);	-- stuff gr_img into tkrport using 'div'
	procedure put_min(gr_img,x,y);	-- stuff gr_img into tkrport using 'min'
	procedure put_max(gr_img,x,y);	-- stuff gr_img into tkrport using 'max'
	procedure put_blend(gr_img,x,y,c1,c2);
					-- blend the image gr_img with the tk widget at position x, y using coefficients c1 and c2

					-- ****** rotated cases of the put operations ****** 
					
	procedure put_imgr(gr_img,x,y);	-- stuff gr_img into tkrport at position x, y
	procedure put_addr(gr_img,x,y);	-- stuff gr_img into tkrport using 'sum'
	procedure put_difr(gr_img,x,y);	-- stuff gr_img into tkrport using 'dif'
	procedure put_mulr(gr_img,x,y);	-- stuff gr_img into tkrport using 'mul'
	procedure put_divr(gr_img,x,y);	-- stuff gr_img into tkrport using 'div'
	procedure put_minr(gr_img,x,y);	-- stuff gr_img into tkrport using 'min'
	procedure put_maxr(gr_img,x,y);	-- stuff gr_img into tkrport using 'max'
	procedure put_blendr(gr_img,x,y,c1,c2);

	procedure get_img(gr_img,x,y);	-- stuff gr_img into tkrport at position x, y
	procedure get_add(gr_img,x,y);	-- stuff gr_img into tkrport using 'sum'
	procedure get_dif(gr_img,x,y);	-- stuff gr_img into tkrport using 'dif'
	procedure get_mul(gr_img,x,y);	-- stuff gr_img into tkrport using 'mul'
	procedure get_div(gr_img,x,y);	-- stuff gr_img into tkrport using 'div'
	procedure get_min(gr_img,x,y);	-- stuff gr_img into tkrport using 'min'
	procedure get_max(gr_img,x,y);	-- stuff gr_img into tkrport using 'max'
	procedure get_blend(gr_img,x,y,c1,c2);
							-- blend the image gr_img with the tk widget at position x, y using coefficients c1 and c2

	-- ****** Font Routines ******
	procedure font_metrics(font);			-- get the metrics of the designated font
	procedure measure_fonted(stg,font);		-- get the size of the string in the designated font
	procedure font_families();				-- get the list of fonts available in Tk

	-- ****** File Routines ******
	procedure disks();			-- get the currently mounted disks

	-- ****** Socket Routines ******
	procedure socket_close();			-- close a socket

	-- ****** Main Control Operations ******

	procedure mainloop();		-- call the tk main loop and wait for callback
	procedure handle_event();	-- GIUSEPPE
	procedure get_event_source_function();	-- GIUSEPPE
	procedure quit();			-- close the tk interpreter
	procedure call(txt);		-- transmit a command to the tk main loop
	procedure setvar(name,val);	-- set a tk variable to the indicated value
	procedure getvar(name);		-- read a tk variable
	procedure waitvar(name);	-- wait for the specified tk variable to change
	procedure update();			-- request screen display update

	-- ****** Miscellaneous Utilities ******
	procedure clock();	-- clock and date utility
		-- returns time in format [very_fine,seconds,dau,month,am_pm,weekno_in_year,mm/dd/yy,abbrev_time,monthno,dayno_in_year,dayno_in_week]

	-- ****** Temporarily exposed for development/debugging ******

	procedure stgs_from_Tk(stg); 	-- get list of strings from Tk blank-delimited form;
	procedure stg_to_Tk(stg);		-- sanitize the quote marks, blanks, backslashes, and square brackets in a string
	procedure as_map(stg); 			-- converts a Tk configuration descriptor string to a mapping from attrbute names to values

-- 				********** Routines for persistency **************	

	procedure get_Tk_packed();		-- gets the Tk packing information as a map
	procedure get_Tk_gridded();		-- gets the Tk gridding information as a map
	procedure get_Tk_children();	-- gets the full hierarchy of Tk children as a map
	procedure setup_from_dump(target_texwidg_name,dump_stg);		-- reconstruct a text area grom its dump string
	procedure sep_tags_and_marks(stg_tup);		-- separate a string's dump tuple into its text, plus tags_and_marks
	procedure reconstruct_image_from_name(img_name);	-- rebuild an existing absolute image using its name
	procedure reconstruct_bitmap_from_name(bm_name);	-- rebuild an existing absolute bitmap using its name

end tkw;

package body doubleclick_pak;			-- supplementarty package  for doubleclick-detector utility routine
use tkw;		-- use the main widget class
	var Tk,prior_id := OM,numcanceled := 0,canvasevent_pending := false;	-- global variables for doubleclick tracking
		

	procedure doubleclikk(the_Tk,proc);	-- wrapper procedure for doubleclick
		Tk := the_Tk;
		
		return lambda;				-- return this closure,  with 'proc' bound in, to be called when a clock occurs 

			if canvasevent_pending then return; end if;		--a non-canvas event cannot cancel a pending canvas event
			if prior_id /= OM then Tk.cancel_event(prior_id); numcanceled +:= 1; end if;

			prior_id := Tk.createtimer(200,catch_procedure(proc));		-- set the catch_procedure (a closure) to be called after a delay

			procedure catch_procedure(proc);	-- catch procedure for doubleclick; binds in the procedure parameter of doubleclick
				return lambda; prior_id := OM;	numc := numcanceled; numcanceled := 0; proc(numc); end lambda;
			end catch_procedure;
		end lambda;

	end doubleclikk;

	procedure canvas_doubleclikk(the_Tk,proc);	-- wrapper procedure for doubleclick
		Tk := the_Tk;
		
		return lambda;				-- return this closure,  with 'proc' bound in, to be called when a clock occurs 
			if prior_id /= OM then Tk.cancel_event(prior_id); numcanceled +:= 1; end if;

			prior_id := Tk.createtimer(200,catch_procedure(proc));		-- set the catch_procedure (a closure) to be called after a delay
			canvasevent_pending := true;		-- note that a canvas item event is  now pending
			
			procedure catch_procedure(proc);	-- catch procedure for doubleclick; binds in the procedure parameter of doubleclick
				return lambda; prior_id := OM;	numc := numcanceled; numcanceled := 0; proc(numc); canvasevent_pending := false; end lambda;
			end catch_procedure;
		end lambda;

	end canvas_doubleclikk;

end doubleclick_pak;

		-- this class uses the tk native package, which provides the routines

	-- procedure tk_create();					-- create a tk interpreter
	-- procedure tk_kall(tkobj,cmd);			-- transmit a command to the tk interpreter
	-- procedure tk_createcommand(tkobj,cmd,fun);
						-- create a new callback command for  the tk interpreter
	-- procedure tk_dooneevent(tkobj);
	-- procedure tk_mainloop(tkobj);			-- call the tk interpreter and wait for a callback
	-- procedure tk_quit(tkobj);				-- close the tk interpreter?????

	-- procedure tk_createtimer(interval,fun);
	-- procedure tk_idlecallback(fun);

-- The following is an alternative version of the tk widget class and various related objects
-- (e.g. canvas items). Each class instance has a tk_type, which can be either button, menu,
-- menubutton, frame, toplevel, label, message, scale, scrollbar, entry, listbox, text, canvas
-- (the builtin tk widgets), or arc, bitmap, image, line, oval, polygon, canvas_text, widget 
-- (the canvas items). The tk interpreter identifies widgets by their place in its name hierarchy,
-- and canvas items by their serial number in the canvas to which they belong. This class gives
-- every item a unique generated name of the form Wnnn (for widgets) or Cnnn (for canvas items),
-- allowing SETL widgets and canvas item objects to be identified rapidly from their tk names.

-- Basic syntactic conventions: the most basic syntactic conventions established by this package
-- are those concerning attribute set/get operations (corresponding to 'cget' and 'configure' operations
-- in Tk, and those having to do with callback operation binding (corresponding to the Tk 'bind' 
-- and the Tk 'command' parameter). attribute set/get operations for a widget w are represented in the form
-- w("attr,attr,..") and w("attr,attr,..") := "val,val,..". Callback operations are bound to events 
-- and the widgets or tags to which these events are delivered by statements of forms like

-- 				w{"event_descriptor:event_fields_signature"} := SETL_procedure;
	
	-- the special case of button, checkbutton, radiobutton, and menu button commands are handled 
	-- without any event_fields_signature, using the syntax

	-- 				obj{OM}	:= SETL_procedure;
	
	-- to implement this syntax, we use the tk_createcommand(interp,tk_command_name,SETL_procedure)
	-- call of the underlying native library. This posts the (parameterless) SETL_procedure to the
	-- tk interpreter, as a new externally implemented command whose name is tk_command_name. This 
	-- routine is called inside the stg_for_tk routine, which converts all non-tk right-hand sides
	-- of such calls to string forms acceptable to the tk interpreter.
	-- More generally, we use this syntax to send its 'principal command' to any widget; this is the
	-- command triggered by whatever we choose to regard as the widget's 'principal event' For
	-- listboxes and tags in text widgets, this is a button-up ; for menubuttons it is
	-- a button-down ; for text entries and text widgets (outside of text tags) it is loss of
	-- focus ; for scales it is dragging motion ; for canvas_items it is button-down
	-- ; for menus it is a button-up ; for frames, toplevels, and canvases 
	-- it is dragging motion .
	
class body tkw;						-- tk widget class; alternative draft
	use tk;							-- use the tk native package
	use string_utility_pak;			-- use various SETL utility packages
	use image;						-- object wrappings for grlib images
	use Tk_interp_holder;			-- small auxiliary package for holding TK interpreter object
	use doubleclick_pak;			-- doubleclick timing package for Tk
	use Tk_defaults;				-- defaults for Tk attribute values
	
	const button := "button", menu := "menu", menubutton := "menubutton", frame := "frame", rastport := "rastport",
			 	toplevel := "toplevel", label := "label",  message := "message",  scale := "scale",
					scrollbar := "scrollbar",  entry := "entry",  listbox := "listbox", text := "text", 
						 canvas := "canvas", checkbutton := "checkbutton", radiobutton := "radiobutton";	
	
								-- the tk event types
	const event_types := {"activate", "buttonpress", "buttonrelease", "circulate", "colormap", " configure",
							 "deactivate", "destroy", "enter", "expose", "focusin", "focusout", "gravity",
							 	 "keypress", "keyrelease", "motion", "leave", "map", "property", "reparent",
							 	 	 "unmap", "visibility", "double", "triple"};

	const event_opts_from_chars :=			-- mapping of event characters to option keywords
		{["#","serial"],["a","above"],["b","button"],["c","count"],["d","detail"],
				["f","focus"],["h","height"],["k","keycode"],["m","mode"],["o","override"],
					["p","place"],["s","state"],["t","time"],["w","width"],["x","x"],["y","y"],
						["B","borderwidth"],["E","sendevent"],["K","keysym"],["R","root"],
							["S","subwindow"],["X","rootx"],["Y","rooty"]}; 
	
	const widgets := {button, checkbutton, radiobutton, menu, menubutton, frame, rastport, toplevel, label, message,
								 		scale, scrollbar, entry, listbox, text, canvas};
						-- note that we do not count 'image' as a widget, but handle it a bit specially,
						-- even though tkw objects of type 'image'will be formed
	
	const main_command := {	["menubutton",""], --["button",""], ["checkbutton",""], ["radiobutton",""],
							 --["scale",""], __ these items  hve built-in '-command'  options
								["menu",""], ["frame",""], ["rastport",""],
								 ["toplevel",""], ["entry",""], 
								 	["listbox",""], ["text",""], ["optionbutton",""], 
								 ["canvas",""], ["label",""], ["message",""],
								 	 	["arc",""],["bitmap",""], ["image",""],
								 	 		 ["line",""], ["oval",""], ["canvas_text",""],  
							["polygon",""], ["rectangle",""], ["widget",""]};
 
	const main_options := {["button","text"],["menu","type"],["menubutton","text"],["frame","hw"],["rastport","hw"],
								["toplevel","hw"],["label","text"],["message","text"],["scale","ft"],
								["scrollbar","orient_w"],["entry","width"],["listbox","height"],
								["text","hw"],["canvas","hw"],["checkbutton","text"],["radiobutton","text"]};

	const horiz_scrollable := {"entry","listbox","text","canvas"};		-- horizontally scrollable widgets
	const fully_scrollable := {"listbox","text","canvas"};				-- fully scrollable widgets
	
	
	const arc := "arc", bitmap := "bitmap", imaje := "image", line := "line", oval := "oval",
						 polygon := "polygon", rectangle := "rectangle", widget := "widget", 
						 			canvas_text := "canvas_text";

	const window := "window", all := "all";
	
	const canvas_items := {arc, bitmap, imaje, line, oval, polygon, rectangle, canvas_text, widget};
								-- image and widget are also text items
	
												-- principal keywords for geometry managers
	const geom_manager_main_atts := {"side","pack","grid","place","coords"};
	const geometry_keywords := {"pack","side","grid","row","column","place"};
												-- keywords indicating geometry manager calls							

	const gen_attributes := 		-- general 'winfo' attributes of widgets
		{"children","showing","manager","parent","rect","wincoords","toplevel","ismapped","height","width",
												-- wincoords is absolute window location of the  toplevel window ancestor of an object 
			"mouse","screendepth","screensize","screenmm"} + 		-- environent attributes
		{"cells", "children", "class", "colormapfull", "depth", "height", "id", 				-- , "geometry" (moved to wm_attributes)
					"ismapped", "manager", "name", "parent", "pointerx", "pointery","reqheight",
						 "reqwidth", "rootx", "rooty", "screen", "screencells", "screendepth", "screenheight", 
							"screenwidth", "screenmmheight", "screenmmwidth", "screenvisual", "server",
								 "toplevel", "viewable", "visual", "visualid", "vrootheight", "vrootwidth",
								 	 "vrootx", "vrooty", "width", "x", "y", "atom", "atomname", "containing",
								 	 	 "interps", "pathname", "exists", "fpixels", "pixels", "rgb",
								 	 	 	 "visualsavailable"};

	const wm_attributes := 		-- general 'wm' attributes of toplevels		 	 	 	 	
		{"wingrid","iconified","iconposition","maxsize","minsize","resizable","sizefrom","winstate","geometry","aspect","title"};

	const wm_attributes_list := ["wingrid","iconposition","maxsize","minsize","resizable","sizefrom","winstate","geometry","aspect","title",
									"height","width","borderwidth","bd", "borderWidth","menu","highlightcolor",
	 										"background","highlightbackground","cursor","relief","takefocus","highlightthickness"];
		
	const for_toplevel_config :=  {"height","width","borderwidth","highlightcolor","background",
									"highlightbackground","cursor","menu","relief","takefocus","highlightthickness"};

	const attributes_of := {	-- maps widget and canvas_item kinds to their valid attributes
					
					-- all widgets have the following attributes, available through the Tk 'winfo' command
					
		[all,{"cells", "children", "class", "colormapfull", "depth", "geometry", "height", "id", 
					"ismapped", "manager", "name", "parent", "pointerx", "pointery", "reqheight",
						 "reqwidth", "rootx", "rooty", "screen", "screencells", "screendepth", "screenheight", 
							"screenwidth", "screenmmheight", "screenmmwidth", "screenvisual", "server",
								 "toplevel", "viewable", "visual", "visualid", "vrootheight", "vrootwidth",
								 	 "vrootx", "vrooty", "width", "x", "y", "atom", "atomname", "containing",
								 	 	 "interps", "pathname", "exists", "fpixels", "pixels", "rgb",
								 	 	 	 "visualsavailable"}],
					
					-- specific widgets have the following additional attributes

		[button,{"activebackground", "activeforeground", "anchor", "background", "bitmap",
					 "borderwidth", "cursor", "default", "disabledforeground",
					 	 "font", "foreground", "height", "highlightbackground", "highlightcolor",
					 	 	 "highlightthickness", "image", "justify", "padx", "pady", "relief",
					 	 	 	 "state", "takefocus", "text", "textvariable", "underline", "width",
					 	 	 	 	 "wraplength"}],

		[menu,{"activebackground", "activeborderwidth", "activeforeground", "background",
					 "borderwidth", "cursor", "disabledforeground", "font", "foreground", 
						"postcommand", "relief", "selectcolor", "takefocus", "tearoff", 
							"tearoffcommand", "title", "type"}],

		[menubutton,{"activebackground", "activeforeground", "anchor", "background", "bitmap",
						 "borderwidth", "cursor", "direction", "disabledforeground", "font",
						 	 "foreground", "height", "highlightbackground", "highlightcolor",
						 	 	 "highlightthickness", "image", "indicatoron", "justify", "menu",
						 	 	 	 "padx", "pady", "relief", "state", "takefocus", "text",
						 	 	 	 	 "textvariable", "underline", "width", "wraplength"}],

		[frame,{"background", "borderwidth", "class", "colormap", "container", "cursor",
					 "height", "highlightbackground", "highlightcolor", "highlightthickness", 
						"relief", "takefocus", "visual", "width"}],

		[toplevel,{"background", "borderwidth", "class", "colormap", "container", "cursor", 
						"height", "highlightbackground", "highlightcolor", "highlightthickness",
							 "menu", "relief", "screen", "takefocus", "use", "visual", "width"}],

		[label,{"anchor", "background", "bitmap", "borderwidth", "cursor", "font", "foreground",
					 "height", "highlightbackground", "highlightcolor", "highlightthickness",
					 	 "image", "justify", "padx", "pady", "relief", "takefocus", "text",
					 	 	 "textvariable", "underline", "width", "wraplength"}],

		[message,{"anchor", "aspect", "background", "borderwidth", "cursor", "font", "foreground",
					 "highlightbackground", "highlightcolor", "highlightthickness", "justify",
					 		 "padx", "pady", "relief", "takefocus", "text", "textvariable",
					 		 	 "width"}],

		[scale,{"activebackground", "background", "bigincrement", "borderwidth", "cursor",
					 "digits", "font", "foreground", "from", "highlightbackground", "highlightcolor",
					 	 "highlightthickness", "label", "length", "orient", "relief", "repeatdelay",
					 	 	 "repeatinterval", "resolution", "showvalue", "sliderlength", 
								"sliderrelief", "state", "takefocus", "tickinterval", "to",
									 "troughcolor", "variable", "width"}],

		[scrollbar,{"activebackground", "activerelief", "background", "borderwidth", 
						 "cursor", "elementborderwidth", "highlightbackground", "highlightcolor",
						 	 "highlightthickness", "jump", "orient", "relief", "repeatdelay",
						 	 	 "repeatinterval", "takefocus", "troughcolor", "width"}],

		[entry,{"background", "borderwidth", "cursor", "exportselection", "font", "foreground", 
					"highlightbackground", "highlightcolor", "highlightthickness", 
						"insertbackground", "insertborderwidth", "insertofftime", "insertontime",
							 "insertwidth", "justify", "relief", "selectbackground", 
								"selectborderwidth", "selectforeground", "show", "state", 
									"takefocus", "textvariable", "width", "xscrollcommand"}],

		[listbox,{"background", "borderwidth", "cursor", "exportselection", "font", "foreground",
					 "height", "highlightbackground", "highlightcolor", "highlightthickness",
					 	 "relief", "selectbackground", "selectborderwidth", "selectforeground",
					 	 	 "selectmode", "setgrid", "takefocus", "width", "xscrollcommand",
					 	 	 	 "yscrollcommand"}],

		[text,{"background", "borderwidth", "cursor", "exportselection", "font", "foreground",
				 "height", "highlightbackground", "highlightcolor", "highlightthickness",
				 	 "insertbackground", "insertborderwidth", "insertofftime", "insertontime",
				 	 	 "insertwidth", "padx", "pady", "relief", "selectbackground",
				 	 	 	 "selectborderwidth", "selectforeground", "setgrid", "spacing1",
				 	 	 	 	 "spacing2", "spacing3", "state", "tabs", "takefocus", "width",
				 	 	 	 	 	 "wrap", "xscrollcommand", "yscrollcommand"}],

		[canvas,{"coords", "background", "borderwidth", "class", "colormap", "container", "cursor",
					 "height", "highlightbackground", "highlightcolor", "highlightthickness",
					 	 "menu", "relief", "screen", "takefocus", "use", "visual", "width"}],

		[arc,{"extent", "fill", "outline", "outlinestipple", "start", "stipple", "style",
					 "tags", "width"}],
					 
--		[bitmap,{,,,,,,,,}],
--		[imaje,{,,,,,,,,}],

		[line,{"arrow", "arrowshape", "capstyle", "fill", "joinstyle", "smooth",
					 "splinesteps", "stipple", "tags", "width"}],

		[oval,{"fill", "outline", "stipple", "tags", "width"}],

		[polygon,{"fill", "smooth", "splinesteps", "stipple", "tags", "width"}],

		[rectangle, {"fill", "outline", "stipple", "tags", "width"}],

		["canvas_text",{"anchor", "fill", "font", "justify", "stipple", "tags", "text",
				 "width"}],

		["text_tag",{"background", "bgstipple", "borderwidth", "fgstipple", "font", "foreground",
					 "justify", "lmargin1", "lmargin2", "offset", "overstrike", "relief", 
					 "rmargin", "spacing1", "spacing2", "spacing3", "tabs", "underline", "wrap"}],

		["canvas_tag",{"arrow", "arrowshape", "capstyle", "fill", "joinstyle", "smooth",
					 "splinesteps", "stipple", "tags", "width"}],

		["image",{"anchor","image","tags"}],			-- attributes of canvas images, not real images

		["widget",{"anchor", "tags", "height", "width", "window"}]
				-- attributes of canvas widgets, not real widgets

	};

								-- indices which can be used to identify menu items
	const menu_index_indices := {"active", "end", "last", "none"};	-- can also be n, @j, or label match pattern

								-- indices which can be used to identify listbox items
	const listbox_index_indices := {"anchor", "end", "active"};			-- can also be n, @i, or @x,y

	const entry_indices := {"anchor", "end", "insert", "sel.first", "sel.last"};
																	-- can also be n or @j

	const text_indices := {"current", "end", "insert", "sel.first", "sel.last"};
					-- can also be line.char, @x,y, image_name, mark_name, widget_name, tag.first, tag.last

	const pack_options := 			-- options for the 'pack' geometry manager	
		{"after","anchor","before","expand","fill","in","ipadx","ipady","ipadx","ipady","side"};					 

	const grid_options := 			-- options for the 'grid' geometry manager	
		{"column","columnspan","row","rowspan","in","ipadx","ipady","padx","pady","ipadx","ipady","sticky"};					 

	const place_options := 			-- options for the 'place' geometry manager	
		{"anchor","x","y","relx","rely","in","width","height","relheight","bordermode"};					 

	const key_attributes := ["extent","window","image","bitmap","smooth","font"];
			-- for determination of canvas item type from item number

	const special_atts := {"sel.anchor","end","insert","sel.first","sel.last","coords"};
		-- special attributes of entry widgets, text widgets, and canvas text items (the two latter have no 'anchor')
		-- for text widgets tag.first  and tag.last are available for all defined tags

	const special_atts_less_anchor := {"end","insert","sel.first","sel.last","coords"};
	
	const pseudo_atts := {"clipboard","fonts","definedFonts","placed","packed",		-- various pseudo_atts
								"gridded","image","type","limits","position", "active", "propagate"};
	
	const special_lefts := {"xscroller", "yscroller", "clipboard", "grab", "sel.anchor", "sel", "active",
			 "xview", "yview" ,"xpercent", "ypercent","limits","position"};		-- various pseudo_atts usable on left

	const rel_atts_of_images := {"anchor","tags","image","align","name","padx","pady"};
				-- relative attributes of images, as distinct from their internal attributes

	const posns_map := {["mac_creator",2],["mac_hiddden",4],["mac_readonly",6],["mac_type",8],["mtime",9],["atime",10],["gid",11],["nlink",12],
			["mode",13],["type",14],["ctime",15],["uid",16],["ino",17],["size",18],["dev",19],["pointer",20]};
						--positions map for file attributes

	
	class var window_open_flag := OM,	-- flag for base window already open
	 		name_ctr := 0,				-- counter for generation of widget names
  			proc_ctr := 0,				-- counter for generation of procedure ids
   			proc_tk_name := { },		-- maps SETL procedures into their tk string names
-- 			obj_of := { },				-- maps widget name to widget object
 			source_of := { };			-- maps canvas image and widget items to their source objects

	var name := ".",		 		-- section of name, between '.'s
		 tk_type := "",		 	-- tk type of object
		 parent := OM;	 		-- parent object of widget
 
	procedure create();		-- creation of fundamental interpreter and empty objects
				-- if not adjusted, all the empty objects created here are seen as the tk root object
									-- initialize the tk interpreter if necessary
		if interp = OM then 
			interp := tk_create();  tk_kall("update"); doubleclick := doubleclikk; canvas_doubleclick := canvas_doubleclikk; 
		end if;
		if window_open_flag = OM then 
			window_open_flag := 0;		-- open master window just once
			tk_kall("frame . -height 300 -width 300 ");
			tk_type := "toplevel";
--			abend_trap := the_end;
		end if;
		
	end create;
 
 	procedure the_end;
 		print("debug_trace: ",debug_trace); tk_kall("beep"); stop;
 	end the_end;
 	
  	procedure tk_kall(cmd);						-- conditionally traces the tk_calls

 		if show_commands then print(cmd); end if;	-- trace the tk_call
  		if for_tk = OM then 
  			res := tk_call(interp,cmd); if show_commands then print(res); end if; return res; 
  		end if;
  										-- then execute it and return the result
  		for_tk with:= cmd; return OM;										-- otherwise  accumulate command
  	end tk_kall;
 
  	procedure do_all_calls();						-- transmit all calls to Tk, as single string
  		if for_tk = OM then  return; end if;		-- nothing to do if not accumulating		
  		tk_call(interp,join(for_tk,"\n")); for_tk := OM;
  	end do_all_calls;

	procedure hold_calls();		-- start accumulating calls to Tk
		do_all_calls(); for_tk := [];
   	end hold_calls;

  	procedure Tk_id(); return name; end Tk_id;		-- returns an object's (short) Tk name 
   	procedure Tk_kind(); return tk_type; end Tk_kind;		-- returns an object's Tk type 

 	procedure Tk_break(); tk_call(interp,"break"); end Tk_break;		-- terminate event handling in the Tk sequence  
 	procedure Tk_continue(); tk_call(interp,"continue"); end Tk_continue;		-- jump  in event handling in the Tk sequence  

 	procedure dooneevent(); tk_dooneevent(interp); end dooneevent;		-- wait for some (any) Tk event

 	procedure do_later(proc); tk_idlecallback(proc); end do_later;
							-- execute a procedure after a short delay 

	procedure obj_from_tkname(tkname);	-- reconstruct a widget from its Tk name
-- print("obj_from_tkname: ",tkname); 

		tkn := rbreak(tkname,":"); tkname := tkn;		-- drop the prefix if full 'str' form is given
  		obj := tkw();		-- create an empty object

 		if #tkname < 2 then		-- return a copy of the root object
 			obj.name := "."; obj.tk_type := "toplevel"; obj.parent := OM;
  			return obj; 
  		end if;
 		
 		klass := tk_kall("winfo class " + tkname);
 		klass := case_change1(klass);
  		obj.tk_type := klass;			-- set the object type
 
  		nayme := rbreak(tkname,"."); rmatch(tkname,"."); 	-- break off the last name fragment
 
  		obj.name := nayme;								-- use the first name fragment
 		obj.parent := obj_from_tkname(tkname);		-- proceed recursively
  		
  		return obj;
  		
  	end obj_from_tkname;

	procedure tk_parent(); return parent; end tk_parent; 	-- the parent object  of  an object

	procedure win_of_pt(x,y);	-- find the widget containing x,y
  		return if (wc := tk_kall("winfo containing " + str(x) + " " + str(y))) = "" then OM else
  																			 obj_from_tkname(wc) end if;
  	end win_of_pt;

	procedure case_change1(stg);			-- workaround for case_change bug
		caps := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; lc := "abcdefghijklmnopqrstuvwxyz"; 
		s1 := stg(1);
		if exists c = caps(j) | c = s1 then stg(1) := lc(j); end if;
		return stg;
	end case_change1;
	
	procedure as_pair(stg); 		-- reduce menu item configuration data to a map
		match(stg,"-"); att_name := break(stg," "); match(stg," "); return [att_name,stg]; 
	end as_pair;
	
	procedure self(x);		-- configuration query, item configuration query, or creation call. 
							-- configuration queries all have the form obj("attr;attr;...").
							-- creation calls have the form parent_obj("kind", "main_param");
							-- 'kind' can be one of the allowed widget kinds, or can be an allowed
							-- canvas item arc, bitmap, image, line, oval, polygon, text, image,
							-- or widget. We give every item a unique generated name 
							-- of the form Wnnn (for widgets) or Cnnn (for canvas items).

		fn := full_name();			-- get full name of item
		
		if x = OM then		-- miscellaneous fetches, depending on widget type
		
			case tk_type
			
				when "listbox" => -- for listboxes, get the currently selected items
					
					num_elts := unstr(tk_kall(fn + " index end"));
					selected := [];
					for m in [0..num_elts] loop
						txt := fn + " selection includes " + str(m); 
						if tk_kall(txt) = "1" then selected with:= (m + 1); end if;
					end loop;
					
					return selected; 

				when "menu" => -- for menus, get the configuration data for al the menu items
				
					num_elts := unstr(tk_kall(fn + " index end"));
					item_info := [];		-- will collect info for each meu item

					for m in [0..num_elts] loop
						txt := fn + " entryconfigure " + str(m); 
						item_info with:= {as_pair(x): x in stgs_from_Tk(tk_kall(txt))};
					end loop;
					
					return item_info; 		-- returntupleof info  items, one for each menu entry 
					
				when "entry" => return tk_kall(fn + " get"); 
								 -- for entries, labels, and messages, get the text

				when "label","message" => return tk_kall(fn + " cget -text"); 
				
				when "text" => stg := tk_kall(fn + " get 0.0 end"); return stg(1..#stg - 1);
							
				when "menubutton" =>  	-- mb(OM) gets the menu of a menubutton
					
					menu_name := tk_kall(fn + " cget -menu");
					
					obj := tkw();		-- create an empty object
					nayme := rbreak(menu_name,"."); rmatch(menu_name,".");
					obj.tk_type := "menu";
					obj.name := nayme;						-- use the first name fragment
  					obj.parent := obj_from_tkname(menu_name);	-- find the menubutton name

					return obj;
					
				when "canvas" => -- for canvases, get the vector of canvas items
					
					items_no_list := breakup(tk_kall(fn + " find all")," ");
					items_list := [];		-- will build
					
					for item_no in items_no_list loop

						sino := str(item_no);
						new_name := "c" + sino;	-- canvas items are named cnn, nn = serial number
						new_item := tkw();				-- form a blank new canvas item
						new_item.parent := self;			-- this canvas is the parent
						kind := tk_kall(fn + " type " + sino);
						if kind = "text" then kind := "canvas_text"; end if;
						if kind notin canvas_items then kind := "widget"; end if;
						new_item.tk_type := kind;			-- note its type
						new_item.name := new_name;			-- note its name	
						items_list with:= new_item;
								
					end loop;
					
					return items_list;

				when "scale" => -- for sliders, get the slider value
				
					return unstr(tk_kall(fn + " get"));

				when "toplevel" => -- for toplevels, get the title
					
					return tk_kall("wm  title " + fn);
	
				when "socket" => -- for sockets, read the socket

					may_error := tk_kall("set er [catch {gets " + name + " result}]");		-- pass gets command to tk
			
					if may_error /= "0" then			-- there was an error
						socket_error := "error: " + may_error;
						tk_kall("close " + name);		-- pass 'close peer' command to tk
						return OM;				-- return OM as the item read
						
					elseif (eofres := tk_kall("set er [eof " + name + "]")) /= "0" then			-- there was an end of file
						socket_error := "";		-- note the end-of_file
					else 
						socket_error := 0;			-- note not end-of_file
					end if;
					
					res := tk_kall("set er $result");
		
--print("now return result: ",socket_error,"**",res);	-- return the result string just read	
					return res;
			
			end case;
			
			if tk_type in canvas_items then			-- get all the information for a canvas item, as a map
--print("tk_type in canvas_items: ",tk_type," ",attributes_of(tk_type));
				att_list := [x: x in attributes_of(tk_type)] with "coords";
				the_attrs := read_attrs_canvas_item(att_list);
				return {[att,the_attrs(j)]: att = att_list(j)};
			end if;
			
		end if; 			-- end of the 'fetch main data' cases
		
		if is_string(x) then		-- configuration query
			-- here we require the string parameter x to be a semicolon-separated list of attribute
			-- names, appropriate to the object type being queried. The corresponding tuple of 
			-- attribute values is returned. Canvas items must be treated specially, 
			-- as must a few strings such as , which we treat as attributes but tk treats differently.
		
			attr_list := chop(x);		-- break into list of attributes

			if tk_type = "entry" or tk_type = "canvas_text" or tk_type = "text"  then
							-- the simple attributes "rect","width","height" are handled specially
				attr_val_tup := if x in {"rect","width","height"} then read_attrs_widget(attr_list) 
									elseif x in gen_attributes then get_winfo_attr(x) 
									elseif x in {"place","pack","grid"} then get_winfo_attr(x) 
										else read_attrs_entry_or_canv_text(attr_list) end if;

			elseif tk_type = "toplevel" and attr_list(1) in wm_attributes then 

				attr_val_tup := get_wm_attr(attr_list);

			elseif tk_type in widgets then			-- this item is some other kind of widget
			
				attr_val_tup := read_attrs_widget(attr_list);
					
			elseif tk_type in {"image","bitmap"} and parent = OM then	-- this is an absolute image
				
				attr_val_tup := [ ];		-- will collect and return the attribute values in a tuple

				for att in attr_list loop	-- 'name' is the name of the image itself
						attr_val_tup with:= tk_kall(name + " cget " +  " -" + att);
				end loop;
					
			elseif tk_type in {"image","bitmap"} and parent /= OM then	-- this is a canvas or text image

				attr_val_tup := read_attrs_can_or_text_im(attr_list);

			elseif tk_type in canvas_items then		-- we have a canvas item 

				attr_val_tup := read_attrs_canvas_item(attr_list);

			elseif tk_type = "file" then		-- get file attributes

				attr_val_tup := read_file_atts(name,attr_list);

			elseif tk_type = "socket" or  tk_type = "server_socket" then		-- get socket attributes; but this is never called

				attr_val_tup := read_socket_atts(name,attr_list);

			else			-- if this object is a text item, we must use its parent and the itemcget
							-- procedure to query its configuration

				attr_val_tup := read_attrs_text_item(attr_list);

			end if;
			
			return if is_tuple(attr_val_tup) and #attr_val_tup <= 1 then attr_val_tup(1) else attr_val_tup end if;

		elseif tk_type = "text" then		-- here x is a tuple and we have a tag attributes or ranges query
			
			[tag,att_names] := x;
			
			if tag = "tag" then		-- we deal with a tag ranges query			
				txt := full_name() + " tag ranges \"" + str(att_names) + "\""; 		-- in this case 'att_names' is really the tag
				limits := breakup(tk_kall(txt)," ");		-- convert to a list of pairs
--print("limits: ",limits,txt);				
				return [[one_indexing(limits(j)),limits(j + 1)]: j in [1,3..#limits]];
			end if;
			
			att_names := chop(att_names);
			
			if att_names = [] then 			-- return all the attributes of the tag
				att_names := attributes_of("text_tag");
				return {[att,tk_kall(full_name() + " tag cget " + tag + " -" + att)]: att in att_names};
			end if;
			
			att_vals := [tk_kall(full_name() + " tag cget " + tag + " -" + att): att in att_names];
--print("att_vals: ",att_vals);
			return if #att_names = 1 then att_vals(1) else att_vals end if;

		else		-- here x is a tuple, so we have an item configuration query, creation call, or pixel fetch

			[kind,the_text] := x;	-- here either the kind must be an integer designating an item, or x is a pair, 
									-- consisting of a valid widget or canvas-item type and its principal parameter.
									-- we check the validity of the parent, create a new blank
									-- widget or canvas item, and fill in its fields name, tk_type,
									-- and parent
			
			if is_integer(kind) then		-- check that this is a menu or a pixel fetch
				
				if tk_type = "image" and parent = OM then			-- image pixel fetch
					txt := name  + " get " + str(kind) + " " + str(the_text); 
					return tk_kall(txt);			-- return the pixel value
				elseif tk_type /= "menu" then
					abort("Numbered item references are only allowed for menus.");
				end if;
				
				options := chop(the_text);
				return tk_kall(full_name() + " entrycget " + str(kind) 
					+/ [" -" + item: item in options]);

			end if;
								-- otherwise we deal with a ****** creation call ******
			the_text := str(orig := the_text);		-- force the parameter to string form

			if kind = "image" and tk_type /= "text" and tk_type /= "canvas" then

				return make_absolute_image(orig);
				-- build an absolute image either from a file name or from an image class absolute image

			elseif kind = "bitmap" and tk_type /= "text" and tk_type /= "canvas" then

				return make_absolute_bitmap(orig);
							-- build an absolute image either from a data  string or a pair

			elseif kind in canvas_items or (kind = "text" and tk_type = "canvas") then
						-- creation of a canvas or text item; parent must be canvas or text

				return make_canvas_or_text(kind,the_text,orig);	-- build a canvas or text item

			elseif kind in widgets or kind = "optionbutton" then			-- any parent is OK; form the name

				return make_new_widget(kind,the_text);	-- build a widget

			elseif kind = "file" then			-- any parent is OK; make a file widget

				return make_file_widget(the_text);	-- build a file widget

			elseif kind = "socket" or kind = "server_socket" then	-- any parent is OK; make a socket widget
	
				return make_socket_widget(orig);	-- build a socket widget; here we want the original form of 
													-- the parameter pair [host_and_or_port,text_blocksize_or_accept_proc]

			elseif kind = "named" then	-- make a widget from its Tk name
				
				Tk_name := rbreak(the_text,":");		-- break Tk name out of print form
				return obj_from_tkname(Tk_name);	    -- reconstruct the tkw-class widget from its full Tk string name 

			else

				abort("The widget type " + kind + " is illegal.");

			end if;

		end if;
		 
	end;

	procedure full_name();	-- finds full tk name string of widget
		return if parent  = OM then name elseif (pfn := parent.full_name()) = "." then "." + name
									else pfn + "." + name end if;
	end full_name;
	
	procedure selfstr();				-- string conversion
		return tk_type + ":" + full_name();		-- type and name
	end selfstr;

	procedure one_indexing(ix_stg); 			-- convert to 1-indexing
		back := rbreak(ix_stg,"."); return ix_stg + str(unstr(back) + 1); 
	end one_indexing;

	procedure read_attrs_entry_or_canv_text(attr_list);
										-- read attributes of an entry widget or canvas text item, with a few 
										-- special attributes: anchor, end, insert, sel.first, sel.last

		if attr_list = [] then 			-- return all the attributes
--print("read_attrs_entry_or_canv_text, null attr_list: ",tk_type);			
			
			return ((as_map(tk_kall(full_name() + " configure")) + 
				{[att,get_winfo_attr(att)]: att in ["children","showing","manager","rect","ismapped","wincoords","toplevel"]})
					- (Tk_data_defaults(tk_type)?{})) with 
					["text",tk_kall(full_name() + if tk_type = "text" then " dump -all 1.0 end" else " get" end if)];
							-- get the text as an attribute; full form if we have a tex widget
		end if;	

		attr_val_tup := [ ];		-- will collect and return the attribute values in a tuple
--print("read_attrs_entry_or_canv_text: ",attr_list,tk_type,special_atts);	

		if tk_type = "canvas_text" then 		-- attributes of canvas text item 

			fn :=  parent.full_name();
	
			for att in attr_list loop		-- loop, using the tk cget command to get the value
				
				if att = "type" then 			-- get the type

					attr_val_tup with:= tk_type; continue;
					
				elseif att notin special_atts_less_anchor then 	-- need not treat specially
							-- not in {"end", "insert", "sel.last", "sel.first", "coords"}:
							 
					att_val := tk_kall(fn + " itemcget " + name(2..) + " -" + att);
					attr_val_tup with:= if att = "font" then "{" + att_val + "}" 
								elseif att = "text" then "\"" + att_val + "\"" else att_val end if;
					
				elseif att /= "coords" then 		-- treat specially, using 'index'
					
					res := tk_kall(fn + " index " + name(2..) + " " + att);
					if res = "selection isn't in item" then res := 0; end  if;
					attr_val_tup with:= res;
				else							-- special treatment for "coords"
					fn := parent.full_name();			-- get the full tk name of the parent canvas
					attr_val_tup with:= breakup(tk_kall(fn + " coords " + name(2..))," ");	
				end if;
				
			end loop;
			
			return [if x = 0 then OM else x end if:  x in  attr_val_tup];			-- done with this case

		end if;
		 
		fn := full_name();	-- otherwise we deal with an entry or text widget 
						-- get the full tk name of this widget or of canvas item parent
		
		if tk_type = "text" and attr_list = [] then
			return tk_kall(fn + " dump -all 1.0 end");		-- get all the information for a text widget
		end if;
		
		for att in attr_list loop		-- loop, using the tk cget command to get the value
					
			if att = "type" then 			-- get the type

					attr_val_tup with:= tk_type; 
					
			elseif att = "tags" and tk_type = "text" then 			-- we have the "tags" attribute of a text widget
				
				tag_list := breakup(tk_kall(fn + " tag names")," ");
				attr_val_tup with:= tag_list;

			elseif att = "marks" and tk_type = "text" then 			-- we have the "marks" attribute of a text widget

				mark_list := breakup(tk_kall(fn + " mark names")," ");
				attr_val_tup with:= mark_list;

			elseif att = "widgets" and tk_type = "text" then 	-- we have the widgets in a text widget
		
				lis := breakup(tk_kall(full_name() + " window names ")," "); 
				return [obj_from_tkname(item): item in lis];

			elseif att = "images" and tk_type = "text" then 	-- we have the images in a text widget
				
				return images();
				
			elseif att notin special_atts then 		-- use ordinary cget call

				attr_val_tup with:= tk_kall(fn + " cget -" + att);	
				
			else  		-- use 'index' call, in form appropriate to entry and text widgets

				attr_val_tup with:= tk_kall(fn + " index " + att);	

			end if;
	
		end loop;
		
		return attr_val_tup;
					
	end read_attrs_entry_or_canv_text;
	
	procedure position_in_window(fn);			-- gets the anchor position of the object from its Tk name
--print("position_in_window: ",fn);												-- relative to the top level window of the object; works for placed objects only
		windn := tk_kall("winfo toplevel " + fn);
		offx := offy := 0;
		while fn /= windn and fn /= "" loop
			if (geometry_val := tk_call(interp,"place info " + fn)) = "" then exit; end if; -- quit if there is an ancestor level which is not 'placed'
--print("geometry_val: ",geometry_val," ",fn);												-- relative to the top level window of the object; works for placed objects only
			geometry_tup := breakup(geometry_val," "); geo_map := {geometry_tup(j..j+1): j in [1,3..#geometry_tup]};   -- break into pairs
			offx +:= unstr(geo_map("-x")); offy +:= unstr(geo_map("-y"));
			rbreak(fn,"."); rmatch(fn,"."); 
		end loop;
		
		return [offx,offy];
		
	end position_in_window;
	
	procedure get_winfo_attr(att);			-- get an attribute available through the Tk 'winfo' primitives
		
		fn := full_name();
--print("fn: ",att," ",fn);
		case att
		
			when "children" => chlist := breakup(tk_kall("winfo children " + fn)," ");
								return [obj_from_tkname(x): x in chlist];
			when "showing" => return tk_kall("winfo viewable " + fn);
			when "manager" => return tk_kall("winfo manager " + fn);		-- pc, grid, or place
			when "parent" => return obj_from_tkname(tk_kall("winfo paren " + fn)); 
			when "rect" =>  -- this returns the element's enclosing  rectangle
							-- the following code works for widgets, but needs to be checked for canvas items
--				[x,y] := position_in_window(fn);
				height := unstr(tk_kall("winfo height " + fn));
				width := unstr(tk_kall("winfo width " + fn));
				return [x := unstr(tk_kall("winfo rootx " + fn)),
								y := unstr(tk_kall("winfo rooty " + fn)),x + width,y + height];
	
			when "ismapped" =>  return unstr(tk_kall("winfo ismapped " + fn));

			when "wincoords" =>  return [unstr(tk_kall("winfo rootx " + fn)),
											unstr(tk_kall("winfo rooty " + fn))];
			when "toplevel" => return obj_from_tkname(tk_kall("winfo toplevel " + fn));
			when "mouse" =>						-- the following are environent attributes
						return [unstr(tk_kall("winfo pointerx " + fn)),
											unstr(tk_kall("winfo pointery " + fn))];
			when "screendepth" => return unstr(tk_kall("winfo depth " + fn));
			when "screensize" => return [unstr(tk_kall("winfo screenwidth " + fn)),
											unstr(tk_kall("winfo screenheight " + fn))];
			when "screenmm" => return [unstr(tk_kall("winfo screenmmwidth " + fn)),
											unstr(tk_kall("winfo screenmmheight " + fn))];
			when "place","pack","grid" => 

				geometry_val := tk_kall(att + " info " + self.full_name());
				val_list := breakup(geometry_val," ");
				geo_map := {[val_list(j)(2..),vljp1]: j  in [1,3..#val_list - 1] | (vljp1 := val_list(j + 1)) /= "{}"};
			
				return geo_map;

			otherwise =>  return unstr(tk_kall("winfo " + att + "  " + fn));

		end case;

	end get_winfo_attr;
--->working
	procedure get_wm_attr(attr_list);		-- get window-manager attributes of toplevel
		
		attvals := [];		-- will  collect
		fn := full_name();	-- widget name
		orig_attr_list := attr_list;		-- save for testing below
		
		if attr_list = [] then 			-- want all attributes
			attr_list := ["wingrid","iconposition","maxsize","minsize","resizable","sizefrom","winstate","geometry","aspect","title"];
		end if;
		
		for att in attr_list loop

			att := if att = "wingrid" then "grid" elseif att = "winstate" then "state" elseif att = "rect" then "geometry" else att end if;  
	
			res := tk_kall("wm " + att + " " + if att =  "interps" then "" else fn end if);
					-- "wingrid","iconposition","maxsize","minsize","resizable","sizefrom","winstate","geometry" = "rect","aspect","title"

			case att		-- return normal tuples where blank-delimited tuples would have been returned
				
				when "grid","maxsize","minsize","resizable" => res := [unstr(x): x in breakup(res," ")];
				
				when "geometry" => [w,h,ul_x,ul_y] := [unstr(x): x in breakup(res,"x+")]; 
									res := [ul_x,ul_y,ul_x + w,ul_y + h]; -- return as standard rectangle
				
			end case;
			
			attvals with:= res;

		end loop;
		
		if orig_attr_list = [] then return {[alj,attvals(j)]: alj = attr_list(j)}; end if;

		return if #attvals = 1 then attvals(1) else attvals end if;
		
	end get_wm_attr;

	procedure containing(x,y);		-- window containing given point
		return tk_kall("winfo containing " + x + " " + y);
	end containing;

	procedure pixels(n);			-- number of pixels corresponding to given size in screen units
		return tk_kall("winfo pixels " + full_name() + " " + n);
	end pixels;

	procedure fpixels(n);			-- floating number of pixels corresponding to given size in screen units
		return tk_kall("winfo fpixels " + full_name() + " " + n);
	end fpixels;

	procedure rgb(color_name);		-- numerical code for named color
		return tk_kall("winfo rgb " + full_name() + " " + color_name);
	end rgb;

	procedure set_wm_atts(attr_list,y);			-- set window-manager attributes of toplevel
		
		fn := full_name();	-- widget name
--print("set_wm_atts: ",fn,attr_list,y);

		if #attr_list = 1 and ((al1 := attr_list(1)) = "geometry" or al1 = "resizable"  or al1 = "maxsize" or al1 = "minsize" or al1 = "aspect")
			and is_tuple(y) and #y > 1 then y := [y]; end if;		-- force to singleton if singleton wanted
		
		hold_over := OM;		-- might have holdovers for processing by reconfigure_from_map
		
		if attr_list = [] then 			-- want to set all attributes from a map
--print("from a map: ",y);
			y("wincoords") := OM; y("rect") := OM;		-- treat these as 'write-only'
			y("toplevel") := OM; y("children") := OM;		-- treat these as 'write-only'
			y("bd") := OM; y("ismapped") := OM; y("manager") := OM; y("showing") := OM;		-- treat these as 'write-only'
			y("Tk_tags") := OM;		-- the tags attributes are handled elsewhere
						-- eliminate read-only attributes of toplevels (can be set only when toplevel being created)
			y("colormap") := OM;		-- can't modify -colormap option after widget is created
			y("visual") := OM;		-- can't modify -visual option after widget is created
			y("use") := OM;			-- can't modify -use option after widget is created
			y("container") := OM;		-- can't modify -container option after widget is created
			y("screen") := OM;		-- can't modify -screen option after widget is created
			y("class") := OM;			-- can't modify -class option after widget is created

			hold_over := {[att,y(att)]: att in for_toplevel_config};			-- holdovers for reconfigure_from_map

			attr_list := [att in wm_attributes_list | y(att) /= OM and att notin for_toplevel_config
				 and att /= "iconposition" and att /= "aspect" and att /= "wingrid"];		-- disable two atributes which may be UNIX only
			y := [ya: att in wm_attributes_list | (ya := y(att)) /= OM and att notin for_toplevel_config
				 and att /= "iconposition" and att /= "aspect" and att /= "wingrid"];
		end if;

		for att = attr_list(j) loop

			att := if att = "wingrid" then "grid" elseif att = "winstate" then "state" elseif att = "rect" then "geometry" else att end if;  
					-- "wingrid","iconposition","maxsize","minsize","resizable","sizefrom","winstate","geometry" = "rect","aspect","title"

			if att = "state" then 		-- may iconify, withdraw, or set to normal
				yj := y(j);
				if yj = "iconic" or yj = "normal" or yj = "withdrawn" then
					yj := if yj = "iconic" then "iconify" elseif yj = "normal" then "deiconify" else "withdraw" end if;
					kall_res := tk_kall(txt := "wm " + yj + " " + fn);
--print("kall_res: ",kall_res," ",txt);
				end if;
				continue;			-- done with this case
			end if;
			
			if att = "geometry" then 			-- parameter must be put in special w_x_h+x+y form
			
				bu_y := if is_string(y(j)) then breakup(y(j),";,") else y(j) end if;	-- decompose the argument if it was transmitted as a delimited string
				[ul_x,ul_y,lr_x,lr_y] := if is_string(bu_y(1)) then [unstr(eltx): eltx in bu_y] else bu_y end if;	-- force to numeric
				param_val := str(lr_x - ul_x) + "x" + str(lr_y - ul_y) + "+" + ul_x + "+" + ul_y;	-- put in special form
				
			else 			-- put parameter in normal blank-delimited form
--print("att,y(j): ",att," ",y(j)," ",j," y: ",y);			
				yy := if is_string(y(j)) then if (yj := y(j)) = "" then ["{}"] else breakup(y(j),";,") end if else y(j) end if;
						-- put nullstring values into Tk form
				param_val := join(if is_string(yy(1)) then yy else [str(z): z in yy] end if," ");
							-- space out parameter components with blanks after forcing to string

			end if;
			
			res := tk_kall("wm " + att + " " + fn + " " + param_val);
--print("set_wm_atts: ","wm " + att + " " + fn + " " + param_val," ",res);			
		end loop;
		
		if hold_over /= OM then reconfigure_from_map(hold_over); end if;
							-- handle remaining ttributes in reconfigure_from_map
		
	end set_wm_atts;

	procedure toplev_bracket_posns(stg); 			-- get top-level bracket positions in original string

		tup := single_out(stg,"{}\\ ");			-- single out significant characters 
 		
		charloc := 0;
		
		toplev := []; parenlev := 0; was_escape := false;		-- will group into top-level bracketed items
		
		for x = tup(j) loop
			
			charloc +:= 1; 			-- location of current character
			
			if x = "{" then
				
				if was_escape then 		-- open paren is escaped; don't collect
					was_escape := false; continue;
				end if;
				
				if parenlev = 0 then toplev with:= charloc; end if;		-- collect parenthesis position at top level
				parenlev +:= 1;			-- advance since now within
				
			elseif x = "}" then
				
				if was_escape then 		-- open paren is escaped; don't collect
					was_escape := false; continue;
				end if;
				
				parenlev -:= 1;			-- decrement since now out
				if parenlev = 0 then toplev with:= charloc; end if; 		-- collect parenthesis position at top level

			elseif x = "\\"  then		-- reverse escape state

				was_escape := not was_escape; continue; 

			else
			
				charloc +:= (#x - 1); 			-- one character was handled above
				
			end if;

			was_escape := false;		-- applied if value not explicitly set aove

		end loop;

		return toplev;		-- return the list of toplevel unescaped  bracket positions
		
	end toplev_bracket_posns;

--	procedure my_single_out(stg,pat); 			-- single out characters in pat
--		if (pat_pl := [j: c = stg(j) | c in pat]) = [] then return stg; end if;
		
--		pieces := if (pp1 := pat_pl(1)) = 1 then [] else [stg(1..pp1 - 1)] end if;		-- will collect
		
--		for pp = pat_pl(j) loop 		-- iterate over all the significant charater locations
--			pieces with:= stg(pp);  	-- take the significant character
--			if (next := (pat_pl(j + 1)?(#stg + 1)) - 1) > pp then   	-- take the next or final piece if not empty
--				pieces with:= stg(pp + 1..next); 
--			end if;  
--		end loop;

--		return pieces;
	
--	end my_single_out;

procedure stgs_from_Tk(stg); 			-- get list of strings from Tk blank-delimited form;
											-- break string at top-level blank positions and de-escape

		toplev := toplev_bracket_posns(stg); 			-- get top_level bracket positions
		
		if toplev = [] then return break_at_blanks(stg); end if;	-- no toplevel bracket positions
		
		pieces := break_at_blanks(stg(1..toplev(1) - 1));		-- break first section

		for k in [1..(ntl := #toplev) - 1] loop
			stg_section := stg(toplev(k) + 1..toplev(k + 1) - 1); 
						-- dont break bracketed sections
			pieces +:= if stg(toplev(k)) = "{" then [stg_section] else break_at_blanks(stg_section) end if;

 		end loop;

		pieces +:= break_at_blanks(stg(toplev(ntl) + 1..));		-- break final section

 		return pieces;
		
	end stgs_from_Tk;

	procedure break_at_blanks(stg); 			-- break string at unescaped blanks, and de-escape 
		
		if stg = "" then return []; end if;		-- empty string become null
		
		just_escaped := false;			-- initialize
		
		cleaned_stg := "";			-- will build
		tup := [];					-- will collect

		for c = stg(j) loop			-- characters of the string

			if just_escaped  then
				just_escaped := false; 
				cleaned_stg +:= 
					if c = "n" then "\n" elseif c = "r" then "\r" elseif c = "t" then "\t" elseif c = "t" then "\\x" else c end if;
				 		-- take the character, which may be a backslash; normally escaped characters are speical cased
			elseif c = "\\" then		-- this is an 'escape'
				just_escaped := true; 
			elseif c = " " then		-- a section ends
				if cleaned_stg /= "" then tup with:= cleaned_stg; end if; cleaned_stg := "";	-- collect and restart 
			else 			-- take this normal chaacter
				cleaned_stg +:= c; 
			end if;

		end loop;
		
		if cleaned_stg /= "" then tup with:= cleaned_stg; end if;  -- collect final section
		
		return tup;			-- return the list of pieces

	end break_at_blanks;

	procedure remove_escapes(stg); 			--  remove Tk escapes from string 
		
		if stg = "" then return ""; end if;	
		
		just_escaped := false;			-- initialize
		
		cleaned_stg := "";			-- will build
		tup := [];					-- will collect

		for c = stg(j) loop			-- characters of the string

			if just_escaped  then
				just_escaped := false; 
				cleaned_stg +:= 
					if c = "n" then "\n" elseif c = "r" then "\r" elseif c = "t" then "\t" elseif c = "t" then "\\x" else c end if;
					 	-- take the character, which may be a backslash; tabs, eols, and hex signs get special treatment
			elseif c = "\\" then		-- this is an 'escape'
				just_escaped := true; 
			else 			-- take this normal chaacter
				cleaned_stg +:= c; 
			end if;

		end loop;
		
		return cleaned_stg;			-- return the cleaned_stg

	end remove_escapes;
	
	procedure as_map(stg); 			-- converts a Tk configuration descriptor string to a mapping from attrbute names to values
--print("as_map: ",stg);
		toplev := toplev_bracket_posns(stg); 			-- get top_level bracket positions

		the_map := {};  parenlev := 0;  -- initialize

		for k in [1,3..#toplev - 1] loop
		
			slash_parity := 0;			-- restart
			
			substg := stg(toplev(k) + 1..toplev(k + 1) - 1);		-- get one configuation descriptor segment
			
						-- we are looking for the pieces delimited by the first and last top level blanks
			attrib := break(substg," ");  match(substg," "); 
			if (attrib := attrib(2..)) = "bg" or attrib = "fg" then continue; end if;		-- these ae just synonyms
			
			last_sig_blank := 0;			-- intiatialize
			 
			for x = substg(kk) loop		-- look for last significant blank
	
				if x = "{" then
					
					if kk > 1 and substg(kk - 1) = "\\" and slash_parity = 1 then 		-- open bracket is escaped
						continue;
					end if;
					
					 parenlev +:= 1;
				
				elseif x = "}" then
					
					if kk > 1 and substg(kk - 1) = "\\" and slash_parity = 1 then 		-- close bracket  is escaped
						continue;
					end if;
					
					 parenlev -:= 1;
				
				elseif x = " " and parenlev = 0 then  -- we have a significant blank
	
					last_sig_blank := kk;
					
				elseif x = "\\"  then
					slash_parity := 1 - slash_parity;
				end if;
	
			end loop;
	
			mv := substg(last_sig_blank + 1..);
			if (nmv := #mv) > 0 and mv(1) = "{" and mv(nmv) = "}" then mv := mv(2..nmv - 1); end if;
			
			the_map(attrib) := mv;
			
		end loop;
 
 		return the_map;
		
	end as_map;

	procedure read_attrs_widget(attr_list);		-- read widget attributes
	
		attr_val_tup := [ ];		-- will collect and return the attribute values in a tuple
	
		fn := full_name();			-- get the full tk name of this widget
		
		if attr_list = [] then 

			res := as_map(tk_kall(fn + " configure")) + 
				{[att,get_winfo_attr(att)]: att in ["children","showing","manager","rect","ismapped","wincoords","toplevel"]}; 
--print("read_attrs_widget, testing listbox: ",);			

			return if tk_type = "listbox" then res with ["text",self(1..#self)]  
						elseif tk_type = "toplevel" then res + get_wm_attr([]) else res end if;

		end if;		-- empty list returns collection of all attributes
	
		for att in attr_list loop		-- loop, using the tk cget command to get the value
			
			if att in gen_attributes then 
--print("gen_attributes read_attrs_widget: ",attr_list);
				if att in {"height","width"} and tk_type /= "toplevel" then 
					attr_val_tup with:= unstr(tk_kall(fn + " cget -" + att)); continue;
				elseif  att = "toplevel" then
					tlevel := tk_kall(" winfo toplevel " + fn);
--print("tlevel:",tlevel);
					attr_val_tup with:= obj_from_tkname(tlevel); continue;
				end if;
				attr_val_tup with:= get_winfo_attr(att); continue; 		-- but width and heightof topleves is read using  'winfo'
			end if;
			
			if att = "selected" and (tk_type = "radiobutton" or tk_type = "checkbutton") then 
										 -- pseudo-attribute: read the associated variable
				varname := tk_kall(fn + " cget -variable ");		-- get name of associated variable
				varval := tk_kall("set " + varname);			-- get value of associated variable
	
				if tk_type = "radiobutton" then
								-- get the value that the variable  would have if this button was on
					corresp_val := tk_kall(fn + " cget -value ");
					attr_val_tup with:= if varval = corresp_val then "1" else "0" end if;								 		
				elseif tk_type = "checkbutton" then
					attr_val_tup with:= varval;
				end if;
				
				continue;				-- done with this case

			elseif att in {"place","pack","grid"} then		-- get the geometry manager info
						-- note that this returns the info relative to the object's parent
				geometry_val := tk_kall(att + " info " + self.full_name());
				val_list := breakup(geometry_val," ");
--print("geometry_val: ",val_list);
				geo_map := {[val_list(j)(2..),vljp1]: j  in [1,3..#val_list - 1] | (vljp1 := val_list(j + 1)) /= "{}"};

				attr_val_tup with:= geo_map;		-- return the geometry information as a map
				continue;				-- done with this case

			elseif att = "font" then 			-- attach "{" and "}"

				attr_val_tup with:= "{" + tk_kall(fn + " cget -" + att) +  "}";
				continue;				-- done with this case

			elseif att in pseudo_atts then 			-- various pseudo-attribute retrieval operations

				case att

					when "active" => 	-- get a scrollbar's active element
						
						attr_val_tup with:=  tk_kall(full_name() + " activate"); continue;

					when "position" => 	-- get a scrollbars currentpositon
						
						int_lis := breakup(tk_kall(full_name() + " get")," ");
						attr_val_tup with:=  [unstr(x): x in int_lis]; continue;

					when "type" => 	-- get the object's type
						
						attr_val_tup with:= tk_type; continue;
						
					when "image" => 	-- get the contents of a canvas as an image_analysis library image
					
--print("widget configuration query: "); return "testing";
						if tk_type = "canvas" then
							image_no := unstr(tk_kall("save " + full_name()));	
									-- this is the opaque integer pointer to the native grlib image object
									-- we create an image-analysis class object from it
							attr_val_tup with:= image(image_no);		-- add to attribute tuple, as ifthis were an attribute
						else		-- use ordinary configuration query
							attr_val_tup with:= tk_kall(fn + " cget -" + att);
						end if;
						continue;
			
					when "clipboard" => 	-- get the contents of the clipboard
		
						attr_val_tup with:= tk_kall("selection get -selection CLIPBOARD");
						continue;

					when "definedFonts" => 	-- get the list of available fonts
					
						items := tk_kall("font names");
						return breakup(items," ");
						continue;

					when "fonts" => 	-- get the list of available fonts
		
						items := tk_kall("font families");
						items_list := [];		-- will collect

						while items /= "" loop
							items_piece := break(items,"{"); rspan(items_piece," ");
							items_list +:= breakup(items_piece," ");
							item_to_close := break(items,"}"); item_to_close +:= match(items,"}");
							items_list with:= item_to_close;
							span(items," ");
						end loop;

						items_list := [item: item = items_list(j) | item /= ""];
						attr_val_tup with:= join(items_list,",");	-- return the comma-separated font list
						continue;
						
					when "placed" => 		-- get the items placed into this widget
						
						items := tk_kall(" place slaves " + full_name());
					
					when "packed" =>  	-- get the items packed into this widget
						
						items := tk_kall(" pack slaves " + full_name());
	
					when "gridded" => 	-- get the the items gridded into this widget
						
						items := tk_kall(" grid slaves " + full_name());

					when "propagate" => 	-- get a window or frame's propagation status
						
						attr_val_tup with:=  tk_kall("pack propagate " + full_name()); continue;

				end case;

				the_list := [obj_from_tkname(x): x in breakup(items," ")];
				attr_val_tup with:= the_list;	-- return the geometry information as a comma-separated list
				continue;
				
			end if;
			
			attr_val_tup with:= tk_kall(fn + " cget -" + att);	

		end loop;
	
		return attr_val_tup;
					
	end read_attrs_widget;

	procedure read_attrs_can_or_text_im(attr_list);		-- read the attributes of a canvas or text image
	
		attr_val_tup := [ ];		-- will collect and return the attribute values in a tuple
		fn := parent.full_name();		-- get the full tk name of the parent canvas or text item
		
		for att in attr_list loop
	
			if att in {"image","bitmap"} then 		-- convert name to an image or bitmap
				im_name := tk_kall(fn + " itemcget " + name(2..) +  " -" + att);
				the_im := tkw();	-- create a new blank object
				the_im.name := im_name; the_im.tk_type := att;
				attr_val_tup with:= the_im; 
			elseif att = "coords" then 		-- use the "coords" operation
				attr_val_tup with:= breakup(tk_kall(fn + " coords " + name(2..))," ");
			else 						-- use att-val itself
				attr_val_tup with:= tk_kall(fn + " itemcget " + name(2..) +  " -" + att);
			end if;	
						
		end loop;
		
		return attr_val_tup;
					
	end read_attrs_can_or_text_im;

	procedure read_attrs_canvas_item(attr_list);	-- read the attributes of a canvas item
						-- The attributes of canvas items are: tags, width, and coords in all cases, plus 
						-- for canvas geometric objects: fill, outline, and stipple 
						-- for images: anchor and image 
						-- for canvas text objects: anchor, fill, font, justify, stipple, and text 
						-- for canvas widgets: anchor, height, and window
	
						-- Tk uses itemcget/itemconfigure calls to get/set all but the coords attributes, 
						-- but a coords calls to get/set the coords attribute.
--print("read_attrs_canvas_item: ",tk_type);
		attr_val_tup := [ ];		-- will collect and return the attribute values in a tuple
	
		fn := parent.full_name();			-- get the full tk name of the parent canvas
	
		for att in attr_list loop		-- loop, using the tk cget command to get the value
										-- unless the attribute is 'coords' or "tags", in which case we use
										-- the parent 'coords' or 'gettags' command to get it
			case att 
				when "coords" =>
					attr_val_tup with:= breakup(tk_kall(fn + " coords " + name(2..))," ");	
				when "tags" =>
					attr_val_tup with:= breakup(tk_kall(fn + " gettags " + name(2..))," ");
				when "type" =>
					attr_val_tup with:= tk_type;
				when "window" =>
					res := tk_kall(fn + " itemcget " + name(2..) +  " -window");
					attr_val_tup with:= obj_from_tkname(res);
				otherwise  =>	
					attr_val_tup with:= tk_kall(fn + " itemcget " + name(2..) +  " -" + att);	
			end case;
			
		end loop;
		
		return attr_val_tup;
	
	end read_attrs_canvas_item;

	procedure read_attrs_text_item(attr_list);	-- read the attributes of a text item
	
		attr_val_tup := [ ];		-- will collect and return the attribute values in a tuple
	
		fn := parent.full_name();			-- get the full tk name of the parent widget
	
		for att in attr_list loop		-- loop, using the tk cget command to get the value
										-- unless the attribute is 'bbox', in which case we use
										-- the parent bbox command to get it, or 'coords',
										
			if att = "bbox" then		-- pseudo-attribute: use the "bbox" command
	
				attr_val_tup with:= breakup(tk_kall(fn + " bbox " + name(2..))," ");	
	
			else
				attr_val_tup with:= tk_kall(fn + " itemcget " + name(2..) +  " -" + att);	
			end if;
			
		end loop;
	
		return attr_val_tup;
				
	end read_attrs_text_item;

	procedure read_file_atts(fname,att_list);		-- get specified attributes of file

		atts := breakup(raw_atts := tk_kall("file attributes " + fname) + " " + 
			tk_kall("file stat " + fname + " fs\nset x \"$fs(mtime) $fs(atime) $fs(gid) $fs(nlink) " + 
					"$fs(mode) $fs(type) $fs(ctime) $fs(uid) $fs(ino) $fs(size) $fs(dev)\"" ) + 
			tk_kall("file writable " + fname)," ");
--print("raw_atts:  ",raw_atts);			
		link := tk_kall("file readlink " + fname);
		m := match(link,"couldn't readlink \"");
		if m/= "" then link := ""; end if;

		atts with:= link;	-- atts are now in the order * creator,2 * hiddden,4 * readonly,6 * mac_type,8 
							-- mtime,9  atime,10 gid,11 nlink,12 mode,13 type,14 ctime,15 uid,16 ino,17 size,18 dev,19 pointer,20

		return [atts(posns_map(att)?("UNDEFINED:" + att)): att in att_list];   -- return list of attributes

	end read_file_atts;

	procedure read_socket_atts(fname,att_list);		-- get specified attributes of socket

	end read_socket_atts;

	procedure make_absolute_image(the_text);	-- build an absolute image
		-- build an absolute image either from a file name or from an image class absolute image
		-- the parameter is taken to be either the file from which the image should be read,
		-- or a string of the special form  designating the 'Grlib' core of 
		-- an image-class image, which must be a 3-plane, discrete image

		if not is_string(the_text) then  	-- assume that it is a image-class image	-- #the_text > 8 and the_text(1..8) = " string
			txt := "set im [image create mimage -opaque \"" + str(the_text) + "\"]";	-- we will call Tk to make a Tk absolute image
--print("make_absolute_image: ",txt);
  		else 								-- assume that we have an image file
			txt := "image create photo " + the_text +  "`" + str(name_ctr +:= 1) + " -file "  + the_text;
		end if;
		
		img_name := tk_kall(txt);		-- call Tk to create the Tk asolute image image from the given grilb image or file

		new_image := tkw();					-- form a blank new object
		new_image.parent := OM;				-- images have no parent
		new_image.tk_type := "image";		-- note its type
		new_image.name := img_name;
								-- note its name, which we make unique
--print("new_image.name: ",new_image.name," ",new_image.full_name());		
		return new_image; 
	
	end make_absolute_image;

	procedure reconstruct_image_from_name(img_name);	-- rebuild an existing absolute image using its name

		new_image := tkw();					-- form a blank new object
		new_image.parent := OM;				-- images have no parent
		new_image.tk_type := "image";		-- note its type
		new_image.name := img_name;			-- note its name
		return new_image; 

	end reconstruct_image_from_name;

	procedure reconstruct_bitmap_from_name(bm_name);	-- rebuild an existing absolute bitmap using its name

		new_image := tkw();					-- form a blank new object
		new_image.parent := OM;				-- images have no parent
		new_image.tk_type := "bitmap";		-- note its type
		new_image.name := bm_name;			-- note its name
		return new_image; 

	end reconstruct_bitmap_from_name;

	procedure make_absolute_bitmap(data);		-- build an absolute image either from a data string or a pair

		img_name := "XBM`" + str(name_ctr +:= 1);			-- generate new name

		if is_tuple(data) then  	-- icon and mask  data are given
			[icon_data,mask_data] := data;	-- unpack
			txt := "image create bitmap " + img_name + " -data \"" + icon_data + "\" -maskdata \"" + mask_data + "\"";
--print("make_absolute_image: ",txt);
  		else   	-- no mask data is given
			txt := "image create bitmap " + img_name +" -data \"" + data + "\"";
		end if;
		
		img_name := tk_kall(txt);		-- call Tk to create the image

		new_image := tkw();					-- form a blank new object
		new_image.parent := OM;				-- images have no parent
		new_image.tk_type := "bitmap";		-- note its type
		new_image.name := img_name;
								-- note its name, which we make unique
--print("new_image.name: ",new_image.name," ",new_image.full_name());		
		return new_image; 
	
	end make_absolute_bitmap;

	procedure make_canvas_or_text(kind,the_text,orig);	-- build a canvas or text item

		if tk_type = "text" then		-- we are creating a text item
			
			if kind /= "image" and kind /= "bitmap" and kind /= "widget" then
				abort("An item of type " + kind + " cannot have a text widget as parent.");
			end if;
					-- otherwise we must create a text image or text widget, both from an object 
					-- of appropriate kind
			null; -- ********* FILL IN ********* 
	
		end if;
		
		if tk_type /= "canvas" and tk_type /= "widget" then 
			abort("An item of type " + kind + " must have a canvas or subcanvas, not a " + 
							tk_type + " as parent.");
		end if;

						-- create the canvas item; if the kind is 'text', the object becomes
						-- canvas_text internally. If it is 'image' or 'widget', the second
						-- parameter is an actual object of type tkw, whose name must be extracted 
						-- for the Tk creation call 
		pref := "";		-- no prefix is used except for 'text'
		
		if kind = "text" then 				-- this becomes "canvas_text" internally, and text is not split
	
			pref := "canvas_";
	
		elseif kind in {"image","bitmap"} then 			-- second parameter must be an image or bitmap object; get its name
			
				txt := full_name() + " create image 0 0 -image " + orig.name;
											-- Note that the image name has no prefixed letter 
				ci_num := tk_kall(txt);		-- this returns the serial number of the image item
--print("bitmap: ",txt);	
				new_item := tkw();				-- form the blank new canvas item
				new_item.parent := self;			-- this canvas is the parent
				new_item.tk_type := kind;		-- note its type
				new_item.name := "c" + ci_num;		-- note its serial number (prefixing a 'c')				
		
				new_name := new_item.full_name();		-- get the full name of the new item
				source_of(new_name) := orig;			-- map this into the source item
--print("source_of: ",source_of);				
				return new_item;
		
		elseif kind = "widget" then  		-- second parameter must be a widget object; get its name
			
				txt := full_name() + " create window 0 0 -window " + orig.full_name();
				ci_num := tk_kall(txt);
	
				new_item := tkw();					-- form the blank new canvas item
				new_item.parent := self;			-- this canvas is the parent
				new_item.tk_type := "widget";		-- note its type
				new_item.name := "c" + ci_num;		-- note its serial number  (prefixing a 'c')			
		
				new_name := new_item.full_name();		-- get the full name of the new item
				source_of(new_name) := orig;			-- map this into the source item
		
				return new_item;
		
		end if;
					-- here we are creating a canvas item
		if kind /= "text" then		-- break up the parameter list

			orig_breakup := the_breakup := chop(the_text);
					-- we allow  non-numeric 'coordinates' as an identifying tags of the newly created canvas item
			tag_locs := {j: x = the_breakup(j) | (exists c in x | (c notin "-0123456789."))};	-- can be floating
			tags := [x: x = the_breakup(j) | j in tag_locs];
			the_breakup := [x: x = the_breakup(j) | j notin tag_locs];
			 
			txt := (fn := full_name()) + " create " + kind + " " +/ [num + " ": num in the_breakup] + " -tag ....";
							-- this special tag identifies the currently created object
			ci_num := tk_kall(txt);			-- create the item, and get the item number which Tk assigns

			if kind = "oval" then tk_kall(fn + " addtag OVAL withtag ...."); end if;	-- add the OVAL tag if needed
							-- ovals are assigned the tag "OVAL", so they can be recognized later

			tags := [tags(j): j in [ntgs := #tags,ntgs - 1..1]];	-- reverse order so that tags come  out in order of creation parameter

			for tag in tags | tag /= "OVAL" loop 		-- attach other tags if any
				res := tk_kall(txt := fn + " addtag " + tag +" withtag ....");
--print("attach other tags: ",kind," ",res," ",txt); 
			 end loop;		

			tk_kall(fn + " dtag ....");			-- remove the special 'current' mark
--print("verify tags after remove: ",tk_kall(fn + " gettags " + ci_num));			
		else						-- dont break up the parameter list

			txt := (fn := full_name()) + " create text 0 0 -text " + "\"" + stg_to_Tk(the_text) + "\"" + " -tag ....";
			ci_num := tk_kall(txt);			-- create the item, and get the item number which Tk assigns

			tags := [];			-- FIX FIX **********
			tags := [tags(j): j in [ntgs := #tags,ntgs - 1..1]] with "all";
					-- here we add the 'all' tag since by default canvas text itmes have no tags
					-- reverse order so that tags come  out in order of creation parameter

			for tag in tags loop 		-- attach other tags if any
				res := tk_kall(txt := fn + " addtag " + tag + " withtag ....");
			 end loop;		

			tk_kall(fn + " dtag ....");			-- remove the special 'current' mark

		end if;
		
--print("\ntxttxt: ",txt," ",tags," ",the_breakup," ",tag_locs," ",orig_breakup); 
		
		new_name := "c" + ci_num;	-- canvas items are named cnnn, where nnn is their serial number				
	
		new_item := tkw();				-- form the blank new canvas item
		new_item.parent := self;			-- this canvas is the parent
		new_item.tk_type := pref + kind;	-- note its type
		new_item.name := new_name;			-- note its name				
		
		return new_item;
	
	end make_canvas_or_text;

	procedure make_new_widget(kind,the_text);	-- build a widget
	
		new_name := "w" + str(name_ctr +:= 1);
		new_widget := tkw();				-- form the blank new widget
		new_widget.parent := self;			-- this widget is the parent
		new_widget.tk_type := kind;			-- note its type
		new_widget.name := new_name;		-- note its name
	
									-- now create it, as a tk object
		tk_name	:= new_widget.full_name();
		
		if kind = "menu" then return make_menu(new_widget,tk_name,the_text); end if;

		if kind = "optionbutton" then return make_optionbutton(new_widget,tk_name,the_text); end if;
		
		if (main_option := main_options(kind)) = "hw" then  -- parameter must be width,height
			[width,height] := chop(the_text);
			suffix := " -width " + width + " -height " + height;
		elseif main_option = "ft" then   				-- parameter must be from,to
			[fromm,too] := chop(the_text);
			suffix := " -from " + fromm + " -to " + too;
		elseif main_option = "orient_w" then   				-- parameter must be 'h' or 'v','width'
			[hv,width] := chop(the_text);
			suffix := " -orient " + if hv = "v" then "vertical" else "horizontal" end if + " -width " + width;
		else
			if main_option = "text" and (the_text?"") /=  "" then the_text := stg_to_Tk(the_text); end if;
					-- put the string used in creation into Tk form
			tt :=  if the_text = "OM" then "" else " \"" + the_text end if + "\"";
			suffix := if the_text = "OM" then "" else " -" + main_option + tt end if;
		end if;
	
--print("creation call: ",kind + " " + tk_name + suffix);			
		tk_kall(kind + " " + tk_name + suffix);
--print("created new_widget: ",tk_name);
	
		return new_widget;					-- return it
	
	end make_new_widget;			

	procedure make_file_widget(the_text);	-- build a file widget

		new_widget := tkw();				-- form the blank new widget
		new_widget.parent := self;			-- this widget is the parent
		new_widget.tk_type := "file";		-- note its type
		new_widget.name := the_text;		-- note the file name
	
		return new_widget;					-- return it
	
	end make_file_widget;			

	procedure make_socket_widget(param_pair);	-- build a socket widget

		new_widget := tkw();				-- form the blank new widget
		new_widget.parent := self;			-- this widget is the parent
		[host_and_or_port,text_blocksize_or_accept_proc] := param_pair;		-- unpack the parameter pair
		
		if is_integer(host_and_or_port) then 		-- host_and_or_port is integer port  number, so socket being created is server

			kind := "server_socket";
			
			if not is_procedure(text_blocksize_or_accept_proc) then 
				print("****** bad server socket accept handler: ",text_blocksize_or_accept_proc); stop;
			end if;
								
			tk_name_for_proc := "s" + str(namegen_ctr := (namegen_ctr?0) + 1);			-- generate a new tk variable name
			tk_createcommand(interp,tk_name_for_proc,text_blocksize_or_accept_proc);	-- register the setl accept-handler procedure under this name
						-- see comment below on semantics and typical form of accept handlers
			txt := "set " + "socket_var " + " [socket -server " + tk_name_for_proc + " " + str(host_and_or_port) + "]";
			
			-- when called upon receipt of  an external connection request by an external process, an accept handler will get a tuple
			-- [tk_socket_id,external_net_address,external_initiating_port] as its 1 parameter. it should immediately convert the tk_socket_id
			-- to a client socket object, and set i/o event routines for this new socket;  these i/o event routines can then read the socket
			-- when input arrives, or  write it.
																						-- compose the tk socket-creation command
			tk_socket_name := tk_kall(txt);	-- pass this command to tk, which responds with a  generated socket name
--print("created server: ",tk_socket_name);
			
		else			-- host_and_or_port is a string 'host_addr:port', so a  client socket is to becreated
	
			kind := "socket";
			
			host := break(host_and_or_port,":"); m := match(host_and_or_port,":");		--break port from 'host_addr:port'
			
			if host_and_or_port = "" and m = ":" then	-- null port, but ":" is present, so this is a  client socket generated by an accepted request
				
				tk_socket_name := host;		-- set tk peer name variable to known name of already generated socket

			elseif host_and_or_port = "" then				-- missing  host name,so  error case

				print("****** bad client socket port: ",host,m,host_and_or_port); stop;

			else			-- we have an  acceptable host name, so we create a client socket
				
				txt := "set " + "socket_var" + " [socket " + host + " " + host_and_or_port + "]";
						-- compose the tk socket-creation command
				tk_socket_name := tk_kall(txt);		-- pass this command to tk, which respondswith a  generated socket name
			end if;
			
			if text_blocksize_or_accept_proc = "text" then		-- configure as a line-oriented client socket, to the indicated host_and_port
	
				txt := "fconfigure $" + "socket_var" + " -buffering line";				-- tk buffer_by_lines command
				tk_kall(txt);		-- pass this command to tk

			elseif not is_integer(text_blocksize_or_accept_proc) or text_blocksize_or_accept_proc <= 0 then
									 		-- should  have integer buffer size; should be configured as 'block'
		
				print("****** bad client socket block size: ",text_blocksize_or_accept_proc); stop;
	
			else					 -- configure as 'block'
	
				buffer_size := text_blocksize_or_accept_proc;			-- this flags block-buffering client sockets			
				txt := "fconfigure $" + "socket_var" + " - buffering full -buffersize " + buffer_size;			-- tk buffer_by_blocks command
				tk_kall(txt);		-- pass this command to tk
			
			end if;
		
		end if;

		new_widget.tk_type := kind;				-- note the socket type
		new_widget.name := tk_socket_name;		-- note the socket name
	
		return new_widget;					-- return it
	
	end make_socket_widget;			

	procedure make_menu(menu_obj,menu_name,descriptor);		-- create the items of a new menu from its descriptor 
		
		tk_kall("menu " + menu_name + " -tearoff 0");		-- create the menu
		define_menu_items(menu_name,descriptor);	-- define the items of the menu
		return menu_obj;
		
	end make_menu;

	procedure make_optionbutton(button_obj,menu_name,descriptor);
		varname := break(descriptor,";"); span(descriptor,";");
		alternatives := "" +/ [" " + x: x in breakup(descriptor,",")];
		button_obj.tk_type := "menubutton";
--print("make_optionbutton: ",menu_name);		
		tk_kall("tk_optionMenu " + menu_name + " " + varname + alternatives);
					-- create the optionbutton and its menu
		return button_obj;
	end make_optionbutton;

	procedure define_menu_items(menu_name,descriptor);		-- define the items of a menu from a descriptor 

		items := breakup(chop(descriptor),":");
		
		for [kind,lab] in items loop

			if lab = OM then			-- should be separator or tearoff

				if kind = "t" then		-- tearoff
					tk_kall(menu_name + " add tearoff");
				else					-- take as separator
					tk_kall(menu_name + " add separator");
				end if;

			else
				
				case kind

					when "c" => 		-- checkbutton item
						tk_kall(menu_name + " add checkbutton -label " + lab + " -indicatoron 1");
					when "r" =>  		-- radiobutton item
						tk_kall(menu_name + " add radiobutton -label " + lab + " -variable " + lab);
					when "s" =>   		-- submenu item
						tk_kall(menu_name + " add cascade -label " + lab);
					otherwise =>  		-- take as button item
						tk_kall(menu_name + " add command -label " + lab);
				end case;
				
			end if;

		end loop;
		
	end define_menu_items;
	
	procedure self(x) := y;		-- assignment of attributes (configuration)
			-- 'self' can reference either a widget, canvas item, image, or  bitmap.
			-- We require x (resp. y) to be comma or semicolon-separated lists of attribute names (resp. 
			-- values), appropriate to the object type being queried. The values are assigned
			-- to the corresponding attributes
			-- y is allowed to be a ;-separated string, a tuple, a procedure, or a widget object. If y is a
			-- string, we cut it into a tuple and proceed  as in the tuple case. empty option names 
			-- can be used with option value strings which identify their options uniquely, 
			-- e.g. for options like 

			-- The 'geometry manager' commands pack, grid, and place can also appear in x,
			-- as initial 'pseudo-attributes'. If they appear, all the other attributes 
			-- which follow them must be legal geometry manager options, and the componts of y
			-- must be legal values for these options.  
	
			-- the canvas-item types are arc, bitmap, image, bitmap,  line, oval, polygon, rectangle, text, 
			-- canvas_widget
	
		if is_integer(y) or is_real(y) then y := str(y); end if;
				-- convert right-hand sides which are not procedures, objects, or tuples into strings
				
		if x = OM then		-- miscellaneous sets of 'whole content', depending on widget type
			return set_whole_contents(y);
				-- set content of an entry, text, message, label, scale, or toplevel widget;
				-- set the menu of a menubutton; write to a client socket
		end if; 

		if x = "" then		-- completely reconfigure widget; y must be a mapping 

			if tk_type = "toplevel" then return set_wm_atts([],y); end if;	-- handle in set_wm_atts
			return reconfigure_from_map(y);				-- handle in reconfigure_from_map
		end if; 
				
		if y = OM then		-- miscellaneous nulling ops of attribute
			return null_whole_attribute(x);	-- null the value of this attribute
		end if; 

		if is_tuple(x) then		-- configuration of a menu item, dialog in toplevel, canvas or text widget tag,
								-- tag in text, or geometry manager configuration to widget other than parent
			
			[itm,the_text] := x;			-- this must have the form object; int, item_attributes,
											-- or "tag",tag_name
						-- if 'the_text' is not a string, it should be a widget object, passed as part of an 
						-- extended geometry manager call
						
			if itm = "font" then 		-- this is a font definition
				nna := #(name_and_atts := chop(the_text));
				font_name := name_and_atts(1); 

				if font_name in breakup(tk_kall("font names")," ") then
					tk_kall("font delete " + font_name);		-- delete the font in case it exists
				end if;
				
				y := chop(y);
				
				att_and_vals := "" +/ [" -" + name_and_atts(j + 1) + " " + yj: yj = y(j) | j < nna];
				txt := "font create " + font_name + att_and_vals;

				return tk_kall(txt);
				
			end if;
			
			if not is_string(the_text) then 		-- we have an extended geometry manager call; 'the_text'
													-- is the widget in which another widget is being packed, 
													-- placed, or gridded. 
													-- The underlying call is like self("side",frame) := "left"
				xx := chop(itm);

				if xx(1) notin geometry_keywords then 
					abort("illegal second parameter b in widget(a,b) := c: " + str(the_text));
				end if;

				return configure_geometry_in(xx,chop(y),the_text);
										-- handle extended geometry-manager calls
					
			end if;
						
			options := if (the_text?"") = "" then [] else chop(the_text) end if;
			
			case tk_type			-- proceed in a manner dependent on the type of this widget

				when "toplevel","" =>		-- pseudo-configuration of dialog in toplevel or absolute master window; or wm  call
	
					return configure_toplevel(itm,options,y); 	-- handle all the standard built-in dialogs
	
				when "text","canvas" =>		
					-- configuration of canvas or text tag, binding of procedure to click on tagged range,
					-- or tag configuration in text
					
					if itm = "tag" and tk_type = "text" then 		--tag configuration in text
																	-- y must be a tuple of pairs

						tk_kall(full_name() + " tag remove " + the_text + " 1.0 end"); 		-- remove present ranges
						the_text := the_text + " " +/ [fi + " " + la + " ": [fi,la] in y];
						return tk_kall(full_name() + " tag add " + the_text);	-- restore new ranges
					end if;
															-- here we are configuring a canvas tag or text tag
															-- break y into its parts if it is a string
					y := chop(y); if not is_tuple(y) then y := [y]; end if;

					txt := full_name() + " tag configure " + str(itm) 		-- in this case 'itm' is the tag name
						+/ [" -" + item + " " + may_quote(tk_string_of(y(j)?"nothing")): item = options(j)];
--print("configuring a tag: ",txt);
					return tk_kall(txt);
	
				when "menu" =>		-- configuration of menu item
					
					if not is_integer(itm) then

--						if itm = "system" and the_text = "menu" then	-- definition of "Apple" menu in menu bar
--							return tk_kall(full_name() + ".apple configure " + " -menu " + y.full_name());
--						elseif itm = "help" and the_text = "menu" then	-- definition of "Help" menu in menu bar
--							return tk_kall(full_name() + ".help configure " + " -menu " + y.full_name());
--						end if;
						
						abort("Only numbered item references are allowed for menus.");

					end if;
					
					if the_text = "menu" then			-- should be assignment of submenu to cascade item
						return tk_kall(full_name() + " entryconfigure " + str(itm) + " -menu " + y.full_name());
					end if;
																-- break y into its parts if it is a string
					y := chop(y); if not is_tuple(y) then y := [y]; end if;
					
					txt := full_name() + " entryconfigure " + str(itm) 
						+/ [" -" + item + " \"" + tk_string_of(y(j)?"nothing") + "\"": item = options(j)];

					return tk_kall(txt);

			end case;

		end if;  -- *********** end if is_tuple(x) *********** 

		y := chop(y); 

		if x = "tags" and tk_type = "text" then		-- configuration of the tag order of a text widget
			
					--  is now the specified tag list. We first drop all elements in it which are not actually tags
			tag_set := {z: z in breakup(tk_kall(full_name() + " tag names")," ")} less "sel";
			y := [z: z in y | z in tag_set]; 
			tag_set -:= {z: z in y}; -- tag_set is now the collection of tags to be dropped
			
				-- All other elements are dropped from the tag set
			if #tag_set > 0 then 
				tk_kall(txt := full_name() + " tag delete" +/ [" " + tag: tag in tag_set]); 
			end if;

			if #y = 0 then return; end if;	-- now we raise all these elements to the end, giving them top priority. 
			tk_kall(txt := full_name() + " tag raise " + y(1));		-- first raise the initial element

			for j in [2..#y] loop 		-- then raise each to the position after the prior
				tk_kall(full_name() + " tag raise " + y(j)  + " " + y(j - 1));
			end loop;
			
			return;

		elseif x in special_lefts then
		-- xscroller, yscroller, clipboard, grab, sel, sel.anchor, xview, yview, xpercent, ypercent, active
--print("special_lefts ",x);		
		case x
				when "xview" =>				-- set the xview in a scrollable widget
					
					txt := full_name() + " xview "+ str(unstr(y(1)?"0") - 1); 
--print("xview: ",txt);
					return tk_kall(txt);

				when "yview" =>				-- set the yview in a scrollable widget
					
					txt := full_name() + " yview "+ str(unstr(y(1)?"0") - 1); 
					return tk_kall(txt);

				when "xpercent" =>				-- set the xview percentage in a scrollable widget
					
					txt := full_name() + " xview moveto " + (y(1)?"0"); 
					return tk_kall(txt);

				when "ypercent" =>				-- set the yview percentage in a scrollable widget
					
					txt := full_name() + " yview moveto " + (y(1)?"0"); 
					return tk_kall(txt);

				when "position" =>				-- set the limits of a scrollbar
					
					txt := full_name() + " set " + str(y(1)?"0") + " " + str(y(2)?"0"); 
--print("limits ",txt);
					return tk_kall(txt);

				when "sel" =>				-- set the selection in a textline or listbox
--print("set the selection: ",y);
					[m,n] := y;
					
					if m = OM and n = OM then 
						txt := full_name() + 
							if tk_type = "entry" then " select clear" else " selection clear" end if;
						 return tk_kall(txt);
					end if;
					
					n := if n = OM then str(unstr(m) - 1) else n end if;
					txt := full_name() + 
						if tk_type = "entry" then " selection range "  else " selection set " end if + 
										str(unstr(m) - 1) + " " + str(unstr(n)); 
--print("set the selection cmd: ",txt);
					res := tk_kall(txt);
					return res;
					
				when "sel.anchor" =>		-- set the selection anchor in a textline or listbox
					
					txt := full_name() + 
						if tk_type = "textline" then " selection from " else " selection anchor " end if + 
								str(unstr(y(1)) - 1); 
					return tk_kall(txt);

				when "active" =>		-- set activated element in a listbox, menu, or scrollbar
					
					txt := full_name() + " activate " + 
							if tk_type = "scrollbar" then y(1) else str(unstr(y(1)) - 1) end if; 
--print("active ",txt);
					return tk_kall(txt);

				when "xscroller" =>			-- attach a scroller to a horizontally scrollable widget
					
					if not tk_type in horiz_scrollable then 		-- error: widget is not scrollable
						abort(tk_type + "widgets are not scrollable");
					end if;
		
					if not type(y) = "TKW"  or not y.tk_type = "scrollbar" then 		-- error: not a scrollbar
						abort("A widget's 'xscroller' attribute must be a scrollbar");
					end if;
				
				-- now link the widget's attribute to the scrollbar, and the scrollbar's command attribute to the widget
					yname := y.full_name(); widname := full_name();
					tk_kall(yname + " configure -command {" + widname + " xview}");
					return tk_kall(widname + " configure -xscrollcommand {" + yname + " set}");

				when "yscroller" =>				-- attach a scroller to a fully scrollable widget
					
					if not tk_type in fully_scrollable then  		-- error: widget is not scrollable
						abort(tk_type + "widgets are not vertically scrollable");
					end if;
		
					if not type(y) = "TKW"  or not y.tk_type = "scrollbar" then 		-- error: not a scrollbar
						abort("A widget's 'yscroller' attribute must be a scrollbar");
					end if;
				
				-- now link the widget's attribute to the scrollbar, and the scrollbar's command attribute to the widget
					yname := y.full_name(); widname := full_name();
					tk_kall(yname + " configure -command {" + widname + " yview}");
					return tk_kall(widname + " configure -yscrollcommand {" + yname + " set}");
		
				when "clipboard" =>		-- assignment of y to clipboard
				
					tk_kall("clipboard clear");
					return tk_kall("clipboard append \"" + str(y(1)) + "\"");		-- here y is transmitted as tuple
		
				when "grab" =>		-- set of a toplevel window grab status
					
					if tk_type /= "toplevel" then abort("'Grab' can only be set for toplevel windows"); end if;

					grab_stg := if y = ["global"] then "grab -global "
									else "grab " end if + full_name();
				
					return tk_kall(grab_stg);

			end case;
			
		end if;
				-- otherwise we have a configuration call, either for a canvas or text item or an ordinary widget

 				-- break x, the string of options to be configured, into a tuple
 		orig_x := x; x := if x = OM then [] else chop(x) end if;
 					-- allow comma if there is no semi. If x = OM we convert it into a 'list of OM's'

--print("configuration call: ",x," ",y," orig_x: ",orig_x," #orig_x: ",#orig_x);
		if tk_type = "image" and parent = OM then		-- must be an absolute image			
			
			return configure_image(x,y);			-- configure the image

		elseif tk_type = "menu" then		-- configure a menu			
			
			return configure_menu(x,y);			-- configure a menu	

		elseif tk_type = "bitmap" and parent = OM then		-- must be an absolute bitmap			
			
			return configure_bitmap(x,y);			-- configure the bitmap

		elseif tk_type in canvas_items then		-- we must configure a canvas item 

			return configure_canvas_item(x,y);			-- configure a canvas item
							
		elseif tk_type = "toplevel" and ((x(1) in wm_attributes) or orig_x = "") then
			 		-- we allow a null string, which sets all attributes from a map
		
			if orig_x = "" then x := []; end if;
			return set_wm_atts(x,y);			-- set window-manager attributes of a toplevel

		elseif tk_type = "file" then		-- we must configure a file item 

			return configure_file_item(name,x,y);			-- configure a file item

		elseif tk_type = "socket" or tk_type = "server_socket" then		-- we must configure a socket item 
	
			return configure_socket_item(x,y);			-- configure a socket item; but this is never called

		end if;
--print("ordinary widget configuration call: ",x," ",y);		
 		case type(y)	-- this is a configuration call for an ordinary widget, or a geometry-manager operation	
  
		  	when "TUPLE" =>					-- we use y in a geometry or configuration call
				
	 			case x(1) 		-- here we handle the geometry-manager related pseudo-configuration operations,
	 							-- and some others 
	
	 				when "pack","side","grid","row","column","place" =>
	 				
	 					return configure_geometry(x,y);		-- handle geometry-manager calls
	
					otherwise =>	-- we have a configuration call for a widget, or canvas or text item
--print("widget/canvas/text configuration call: ",x,"",y);
						if tk_type = "toplevel" and #x = 1 and x(1) = "rect" then		-- configuring  the rectangle of a toplevel window
							
							geomstg  := str(abs(y(3) - (y1 := y(1)))) + "x"+ str(abs(y(4) - (y2 := y(2)))) + "+" + str(y1) + "+" + str(y2);	
										-- geometry string in  
							tk_kall(txt := "wm geometry " + full_name() + " " + geomstg);			-- set the specified geometry
--print("winconfig: ",txt);
							return;			-- done with this case
								
	 					elseif (#name > 0 and name(1) = "w") or tk_type = "toplevel" then 		-- we are configuring a Tk widget or toplevel

	 						the_text := full_name() + " configure ";

	 					else				-- we are configuring a canvas or text item
	
							if x = "coords" then  	-- if the original string x is simply 'coords', y will be 
													-- the string of coordinates being assigned; otherwise
													-- this will be y(j) in the loop below
							  	coord_text := parent.full_name() + " coords " + name(2..) + " " 
							  						+/ [str(xx) + " ": xx in y];
--print("coord_text: ",coord_text);
							  	return tk_kall(coord_text);	-- execute the 'coords' command; then finished
							end if;		-- otherwise this is not a coords call; handle normally
	    					
	    					the_text := parent.full_name() + " itemconfigure " + name(2..) + " "; 

	  					end if;
	  					
	  					attribs_to_handle := 0;		-- count of attributes not  handled  in subroutine
	  					
	 					for xj = x(j) loop		-- assemble the options and option values
	 						
	 						if handle_pseudo_attrib(name,xj,y(j)) then continue; end if;
	 										-- we are done with this case if 'true' is returned; otherwise not
							attribs_to_handle +:= 1;		-- count of attributes not  handled  in subroutine
			 				if is_procedure(yj := y(j)?"") then
								
							-- call the tk library 'createcommand' function, to associate a 
							-- new command id of the form Pnnn with the SETL callback procedure supplied;
							-- then include the command id in the command string being built

									tk_createcommand(interp, item := "P" + str(proc_ctr +:= 1) ,y(j));
											-- we will include the callback id in the command being built
						 	elseif type(yj) = "TKW" and yj.parent = OM and yj.tk_type in {"image","bitmap"} then

						 		item := yj.name;	  -- we are assigning an absolute image or bitmap; use its name
						 							  -- Note that absolute images and bitmaps are referenced by their name

 						 	elseif xj = "scrollregion" then
 						 	
 						 		the_text +:= (" -" + xj + " {" + join(y," ") + "} ");
-- print("scrollregion: ",the_text);
						 		continue;

						 	else  		-- item should be a tk string value

								if yj = "" then 
									item := " {}"; 		-- transmit nullstrings in Tk form
								elseif yj(1) = "{" then 		-- special case for fonts; omit quotes
									item := " " + str(yj);	
								else
						 			item := " \"" + str(yj) + "\"";		-- include the string value in the command being built
 								end if;

				  			end if;
--print("fonts, bitmaps: ",xj," ",item);    					
	    					the_text +:= if xj = "font" or xj = "bitmap" or xj = "image" then (" -" + xj + " " + item)
	-- fonts, bitmaps, and images not quoted. Note: for images, only forms like label("image") := "{}" are used
	    										else (" -" + xj + item) end if;
	    															-- add to command if not pseudo-att
	 
	 					end loop;
	
	 			end case;	
--print("the_text:  ",the_text);
				if attribs_to_handle = 0 then return ""; end if;		-- if all attributes are  handled in subroutine, there  is nothing to do	
			  	return tk_kall(the_text);		-- we finish the operation here
 				  						-- a SETL callback procedure (for commands), or a tk string value

	  when "PROCEDURE","TKW" => 	-- the right-hand side is a procedure or tk widget. convert it to tk string form
	  								-- ignore all but the first component of the left-hand parameter tuple
			
--if type(y) = "TKW" then print("TKW case: ",x," ",y); end if;		
			the_text := full_name() + " configure -" + x(1) + " " + tk_string_of(y);
			return tk_kall(the_text);

	  otherwise => 		-- the right-hand side is neither a string, tuple, or procedure; might be absolute image

		 	 if x(1) = "propagate" then  		-- set propagation attribute of frame or window
		 	 	tk_kall("grid propagate " + full_name() + " " + y);		-- set both the grid and the pack attributes
			 	return tk_kall("pack propagate " + full_name() + " " + y);
			end  if;
		
			the_text := full_name() + " configure -" + x(1) + " " + str(y);
--print("config call, final case: ",the_text);
			return tk_kall(the_text);
		
	  end case;

	end;			-- of procedure for self(x) := y; operations

	procedure analyze_text(raw_text);		-- raw text analysis routine

		 -- given a raw_text, this returns the same text with all tag and mark designators removed, along with
		 -- two lists: a tag list of the form [i,j,tag] giving the opening and closing 'line.char' index of 
		 -- each tagged section, and a marks list of the form [i,mark] giving the 'line.char' index of the
		 -- mark position.

		num_lines := 1;		-- number of the current line
		
		raw_text_sections := single_out(raw_text,"`\r\n>");	-- break into sections
--print("raw_text: ",raw_text,"\nraw_text_sections: ",raw_text_sections);		
		len_raw := #raw_text;			-- get the length of the raw text
		current_aux := ""; current_aux_len := 0;	-- current auxiliary string
		tags_list := []; 			-- list of completed tags
		posns_of_open := {};			-- maps open tags and marks into their list of positions
		inside_of_opener := false; inside_of_closer := false;
		start_of_tag := 0;
		end_of_last_opener := OM; last_tag_opened := OM;	-- ending position of last tag opener 
		
			-- the starting position of a possible tag string, if we are inside_of_opener or inside_of_closer
		raw_text_loc := 1;	-- next character in raw text to be examined
		digested_text := "";	digested_length := 0;		-- the tag-free text, and its length within this line
	
		rtsix := 0;
		
		while (section := raw_text_sections(rtsix +:= 1)) /= OM loop		-- iterate over the sections
--print("section: ",section,20 * " ",digested_text," ",inside_of_opener," ",inside_of_closer);	
			if (ns := #section) = 0 then continue; end if;
			if (ns > 1 or section notin "`\r\n") and not (inside_of_opener or inside_of_closer) then
									-- we have an inactive section
				
				digested_text +:= section;	digested_length +:= (ns := #section);
				raw_text_loc +:= ns;		-- and advance in the raw text	
				continue;		-- done with this piece
	
			end if;								-- otherwise we have an active character
			
			raw_text_loc +:= #section;		-- advance this to the next character past that being examined
			
			if section = "`" then	 
				
				if inside_of_opener or inside_of_closer then	-- check to see if we are at the end
	
					if raw_text_loc <= len_raw and raw_text(raw_text_loc) = ">" 
						 and raw_text_loc - 1 > current_aux_len 
							 and raw_text(raw_text_loc - current_aux_len - 1..raw_text_loc - 2) = current_aux then
														-- we are at the end of an opener or closer
	
						tag_completed := raw_text(start_of_tag..raw_text_loc - current_aux_len - 2);
						
						if inside_of_opener then			-- we have completed an opener
	
							inside_of_opener := false;
							last_tag_opened := tag_completed;
							end_of_last_opener := raw_text_loc;
							posns_of_open(tag_completed) := 
							  (posns_of_open(tag_completed)?[]) with (str(num_lines) + "." + str(digested_length));
--print("completed an opener: ",tag_completed," ",posns_of_open);
							raw_text_loc +:= 1; 
							raw_text_sections(rtsix + 1) := raw_text_sections(rtsix + 1)(2..);	-- drop the '>'
							
						else		-- we have completed a closer; see if it is null, and if it closes anything
--print("completed a closer: ",tag_completed," ",end_of_last_opener," ",start_of_tag - 4 - current_aux_len);
	
							inside_of_closer := false;
	
									-- when a tag ends, we must see if it is a null tag. If so, we take it as a  
									-- current_aux change. if not, we generate an entry in the tags_list						
							if end_of_last_opener = start_of_tag - 4 - current_aux_len then
										-- we have ...`><`..., so a null tag
	
								current_aux_len := #(current_aux := tag_completed);
								posns_of_open(tag_completed) := OM;		-- this null tag is no longer open
--print("current_aux changed to: ",current_aux);
							elseif #(opened := posns_of_open(tag_completed)) > 0 then	
											-- tag does not apply to null section and should not be ignored
								tags_list with:= [opened(1),
									(str(num_lines) + "." + str(digested_length)),tag_completed];
											 			-- add run to list of completed tags
								posns_of_open(tag_completed) := OM;		-- this tag is no longer open
								
							end if;
	
							raw_text_loc +:= 1; 
							raw_text_sections(rtsix + 1) := raw_text_sections(rtsix + 1)(2..);	-- drop the '>'
	
						end if;
	
					end if;	-- else not at the end; just bypass the ` character, which becomes part of the tag
				
				else		-- we are not in an opener or closer; check to see if a new opener or closer is starting
--print("see if strting: ",raw_text_loc," ",raw_text);					
					if raw_text_loc > 2 and raw_text(raw_text_loc - 2) = "<" then
									-- may have either an opener or a closer
	
						if raw_text_loc <= len_raw and raw_text(raw_text_loc) = "`" 	
																-- possibly start of closer
						   and raw_text_loc + current_aux_len <= len_raw and 
							raw_text(raw_text_loc + 1..raw_text_loc + current_aux_len) = current_aux then
												-- definitely is start of closer
		
							start_of_tag := raw_text_loc + current_aux_len + 1;		-- note start of tag
							inside_of_closer := true;
							rtsix +:= 1; raw_text_loc  +:= 1;	-- the following "`" character  has been handled
							digested_text := digested_text(1..#digested_text - 1);	-- drop the opening '<'
							digested_length -:= 1;
							continue;					-- this "`" character has been handled
						
						elseif raw_text_loc + current_aux_len <= len_raw 
							and raw_text(raw_text_loc..raw_text_loc + current_aux_len - 1) = current_aux then
													-- start of opener
		
							start_of_tag := raw_text_loc + current_aux_len;		-- note start of tag
							inside_of_opener := true;
							digested_text := digested_text(1..#digested_text - 1);	-- drop the opening '<'
							digested_length -:= 1;
							continue;			-- this "`" character has been handled
	
						end if;		-- otherwise just collect the character
					
					end if;	-- end case in which we are not inside_of_opener or inside_of_closer
						
					digested_text +:= section;	digested_length +:= 1;	
					
				end if;		-- end treatment of "`" character 
				
			elseif section in "\r\n" then	-- current character is a carriage return or linefeed
	
				num_lines +:= 1; digested_length := 0;			-- start a new section
	
				if inside_of_opener then		-- the opener ends; all characters back to the initial <`ccc
										-- must be digested
					digested_text +:= (addst := raw_text(start_of_tag - 2 - current_aux_len..raw_text_loc - 1)); 
					inside_of_opener := false;		-- no longer inside_of_opener
					
				elseif inside_of_closer then		-- the closer ends
	
					digested_text +:= 
							(addst := raw_text(start_of_tag - 3 - current_aux_len..raw_text_loc - 1) + section); 
					inside_of_opener := false;		-- no longer inside_of_opener
					
				else							-- just collect the character
					digested_text +:= section;
				end if;
	
	--		else				-- something else inside an opener or closer; just bypass
	
			end if; 
	
		end loop;
		
--print("digested_text: ",digested_text); print("tags_list: ",tags_list);  print("posns_of_open: ",posns_of_open);
		
		return [digested_text,tags_list,posns_of_open];	-- the remaining open tags becomes the marks_list returned
	
	end analyze_text;
	
	procedure setup_text(tags_list,marks_list);		-- set up pre-analyzed text in Tk text area (self)

		for [range_start,range_end,tag] in tags_list loop
			tag_add_no_offs(tag,range_start,range_end);
		end loop;
	
		for [mark,mark_locs] in marks_list, n in mark_locs loop
--			[n1,n2] := breakup(n,".");
			mark_set(mark,n);
		end loop;
		
	end setup_text;

	procedure set_whole_contents(y);	-- set content of an entry, text, message, or label widget to y
				-- set the slider position of a scale, or the title of a toplevel widget;
				-- set the menu of a menubutton; write to a client socket
		
		if tk_type /= "menubutton" and tk_type /= "toplevel" then y := stg_to_Tk(str(y)); end if;	-- force y to sanitized string form
--print("converted y: ",y);		
		case tk_type
			
			when "entry" => 	-- entry(OM) := y sets the whole entry widget text
				tk_kall(full_name() + " delete 0 end"); 
				txt := full_name() + " insert 0 \"" + y + "\"";		-- y has been converted to Tk form above
--print("setting entry: ",txt);
				return tk_kall(txt); 
			
			when "text" =>  	-- text(OM) := y sets the whole text widget contents, after text analysis
				
				[vis_text,tag_list,mark_list] := analyze_text(str(y));
--print("vis_text: ",vis_text,"*");				
				tk_kall(full_name() + " delete 1.0 end"); 
				to_ret :=  tk_kall(full_name() + " insert 1.0 \"" + vis_text + "\""); 
				setup_text(tag_list,mark_list);

				return to_ret;
				
			when "message","label" =>  	-- message(OM) := y, etc.  sets the whole message or label widget text
	
				return tk_kall(full_name() + " configure -text \"" + y + "\""); 		-- y has been converted to Tk form above
			
			when "scale" =>  	-- slider(OM) := y sets the slider position
			
					variable := tk_kall(full_name() + " set " + y);
			
			when "toplevel" =>  	-- toplevel(OM) := y sets the title

				return tk_kall("wm title " + full_name() + " {" + y + "}"); 		-- y has NOT been converted to Tk form above
			
			when "menubutton" =>  	-- toplevel(OM) := y sets the menu of a menubutton

				return tk_kall(full_name() + " configure -menu " + y.full_name()); 
				
			when "socket" =>  	-- socket(OM) := y writes to a socket

				tk_kall("puts " + name + " \"" + y + "\"");		-- pass 'write string' command to tk
						-- y has been converted to Tk form above
		
			otherwise => abort("Illegal object type " + tk_type + " in set_whole_contents operation");
			
		end case;
	
	end set_whole_contents;

	procedure reconfigure_from_map(att_map);		-- reconfigure all attributes using  attribute map
	
		defaults := Tk_data_defaults(tk_type);  -- get the default attribute values

		att_map +:= {[x,y]: [x,y] in defaults | att_map(x) = OM};

		att_map("wincoords") := OM; att_map("rect") := OM;		-- treat these as 'write-only'
		att_map("toplevel") := OM; att_map("children") := OM;		-- treat these as 'write-only'
		att_map("bd") := OM; att_map("ismapped") := OM; att_map("manager") := OM; att_map("showing") := OM;		-- treat these as 'write-only'
		att_map("Tk_tags") := OM;		-- the tags attributes are handled elsewhere

		if tk_type = "frame" or tk_type = "toplevel" then 
					-- eliminate read-only attributes of toplevels (can be set only when toplevel being created)
			att_map("colormap") := OM;		-- can't modify -colormap option after widget is created
			att_map("visual") := OM;		-- can't modify -visual option after widget is created
			att_map("use") := OM;			-- can't modify -use option after widget is created
			att_map("container") := OM;		-- can't modify -container option after widget is created
			att_map("screen") := OM;		-- can't modify -screen option after widget is created
			att_map("class") := OM;			-- can't modify -class option after widget is created
		end if;
		
		if tk_type = "listbox" then 
			items := att_map("text"); att_map("text") := OM; 		-- get the listbox items; this is not a standard  attribute
		end if;
		
		if tk_type = "entry" then 
			contents := att_map("text"); att_map("text") := OM; 		-- get the listbox items; this is not a standard  attribute
		end if;
		
		att_string := "" +/ ["-" + x + " " + if (sty := str(y)) = "" then "{}" else " {" + sty + "} " end if  
											+ " ": [x,y] in att_map];   -- stg_to_Tk(str(y))

		txt := (fn := full_name()) + " configure " + att_string;			-- set up the reconfiguration command
--if tk_type = "frame" then print("reconfiguration command: ",txt); end if;
		res := tk_kall(txt);
--if tk_type = "toplevel" then print("reconfiguration result: ",res); end if;

		if tk_type = "listbox" then 		-- must set the listbox list elements
			tk_kall(fn + " delete 0 end");		--  drop all the present items
			res := tk_kall(fn + " insert end " + join(["{" + item + "}": item in items]," "));		
						-- insert the new items, quoting them (need to sanitize beter)
		end if;
		
		if tk_type = "entry" then 
			contents := set_whole_contents(contents); 		-- set the text contents
		end if;

		return res;
		
	end reconfigure_from_map;

	procedure null_whole_attribute(att);	-- null the value of this attribute
	
		if att in geom_manager_main_atts then		
					-- if the side, pack, grid, or place attribute is nulled, then erase the item
			if name(1) = "c" then  -- we have a canvas item
				tk_kall(parent.full_name() + " delete " + name(2..));	-- delete the canvas item

						-- if it is an image, then delete the source image (THIS IS A TEMPORARY FIX, SHOULD BE:)
						-- if it is an image or a widget, then remove the reference from the source_of map,
						-- and destroy the object when no references to it remain
				
				if (so := source_of(fna := full_name())) /= OM then 	-- the source must be an image; delete it
						res := tk_kall("image delete " + so.name);
						source_of(fna) := OM;		-- remove from the source_of map
--print("so: ",so," res= ",res);				
				end if;
				
			else  -- we have a widget
				tk_kall(if att = "side" then "pack" else att end if + " forget " + full_name());
			end if;

		else

			case att
		
				when "grab" =>
			
					tk_kall("grab release " + full_name());
					
				when "placed" =>		-- drop all the placed items
						
					items := tk_kall(" place slaves " + full_name());
					tk_kall(" place forget " + items);
		
				when "packed" =>		-- drop all the packed items
						
					items := tk_kall(" pack slaves " + full_name());
					tk_kall(" pack forget " + items);
		
				when att = "gridded" =>		-- drop all the gridded items
						
					items := tk_kall(" grid slaves " + full_name());
					tk_kall(" grid forget " + items);
			
			end case;
		
		end if;
		
	end null_whole_attribute;

	procedure configure_toplevel(itm,options,y); 	-- handle all the standard built-in dialogs 
				
		y := chop(y);
		
		case itm
		
			when "ask" =>	-- open a general choice dialog
		-- parameters of tk_dialog call are: win,title,message,(bitmap = {} if none),labels,default_num
				
				opt_vals := {[opt,str(y(j))]: opt = options(j)};  -- maps options to their values if given

									-- prepare the label list in proper form
				labels := "" +/ ["\"" + stg_to_Tk(label) + "\" ": label in chop(opt_vals("labels")?"")];

				txt := "tk_dialog " + full_name()  + " \"" + opt_vals("title")?"{}"  + 
					"\" \"" + opt_vals("message")?"{}" + "\" " + 
					if (ovbm := opt_vals("bitmap")) /= OM then "\"" + ovbm + "\"" else "{}" end if + 
						" " + str(unstr(opt_vals("default")) - 1)?"{}" + " " + labels;
		
			when "ask_ok" =>	-- open an ask_ok dialog of some type
				
				txt := "tk_messageBox" +/ [" -" + opt + " \"" + y(j) + "\" ": opt = options(j)];
 					
			when "ask_color" =>	-- open a color-picker dialog
				
				txt := "tk_chooseColor" +/ [" -" + opt + " \"" + y(j) + "\" ": opt = options(j)];
		
			when "ask_file" =>	-- open an open-file dialog
				
				if (opt := options(1)) = "filetypes" then 				-- use only the first option
					txt := "tk_getOpenFile -" + opt + " {"  +/ [yval + " ": yval = y(j)] + "}";
				else
					txt := "tk_getOpenFile" +/ [" -" + opt + " " + y(j): opt = options(j)];
				end if;
	
 			when "ask_save_file" =>	-- open a save-file dialog
				
				txt := "tk_getSaveFile" +/ [" -" + opt + " " + y(j): opt = options(j)];

			otherwise  =>	abort("Illegal configuration call " + itm + " for toplevel widget.");

		end case;

		return (dialog_response := tk_kall(txt));

	end configure_toplevel;

	procedure configure_image(x,y);			-- configure an absolute image

		y := if y = OM then [ ] else chop(y) end if;
	
		for att = x(j) loop			-- set designated intenral attributes of the image

			if att = "file" then			-- we read or clear the image
				txt := "image delete " + name; 		-- clear the image in any case; Note that absolute images are referenced by their name
				if y(j) /= OM then 
					txt +:= ("\n image  create photo \"" + name + "\" -file " + y(j)); 
				end if;

			else						-- simply configure the attribute
				txt := name + " configure -" + att + " \"" + (y(j)?"") + "\"";
			end if;
			
			tk_kall(txt);		-- perform the Tk operation 

		end loop;
			
	end configure_image;

	procedure configure_bitmap(x,y);			-- configure an absolute bitmap

		y := if y = OM then [ ] else chop(y) end if;
	
		for att = x(j) loop			-- set designated intenral attributes of the image

			if att = "data" then			-- we read or clear the image

				txt := "image delete " + name; 		-- clear the image in any case; Note that absolute images are referenced by their name
				if y(j) /= OM then 
					txt +:= ("\n image  create bitmap \"" + name + "\" -file " + y(j)); 
				end if;

			else						-- simply configure the attribute
				txt := name + " configure -" + att + " \"" + (y(j)?"") + "\"";
			end if;
			
			tk_kall(txt);		-- perform the Tk operation 

		end loop;
			
	end configure_bitmap;

	procedure configure_menu(x,y);			-- configure a menu
		
		x_to_y := {[xc,tk_string_of(y(j)?"")]: xc = x(j)};
			-- convert procs  and nullstrings in  y to their Tk forms and  represent  as map
		
		type_and_attvals := read_whole_menu();
		men_fn := full_name();		-- full name of  the menu being reconfigured
		tk_kall("destroy " + men_fn);	-- destroy the present menu, in  preparation for re-creation
			--  assign the new menu attributes
		menu_attvals := type_and_attvals(1);
		for x in domain(menu_attvals) | (new := x_to_y(x)) /= OM loop menu_attvals(x) := new;  end loop;
--rbreak(men_fn,"."); men_fn +:= "w1000";
		new_menu_string := "menu " + men_fn +/ [" -" + option_name + " " + tk_string_of(option_val): [option_name,option_val] in menu_attvals];
--print(new_menu_string);
		tk_kall(new_menu_string);			-- recreate the menu  with  its  new attributes
		
				-- now add back all  the former items
		for j in [2..#type_and_attvals] loop
			item_attvals := type_and_attvals(j);		-- attribute map for the items
			new_item_string := men_fn  + " add "  + item_attvals("type") + " "  
					+/ [" -" + option_name + " " + tk_string_of(option_val): [option_name,option_val] in item_attvals | option_name /= "type"];
			tk_kall(new_item_string);
--print(new_item_string);
		end loop;
		
	end configure_menu;

	procedure read_whole_menu();			-- get the type and  entry values of  a  menu
			-- this returns the menu data as a tuple of maps, the first component representing the menu attributes and  the remaining
			-- representing the sucessibe menu items.  Each map sends attribute namesinto attribute values
		men_len := unstr(tk_kall((men_name  := full_name()) + " index  end"));

		menu_optnames := breakup("activebackground,activeforeground,background,foreground,borderwidth,activeborderwidth,cursor,"
				+  "disabledforeground,font,relief,takefocus,postcommand,selectcolor,tearoff,tearoffcommand,title,type",",");

		data_tup := [{[optname,tk_kall(men_name + " cget -"  +  optname)]: optname in menu_optnames}];			-- will collect more

		menu_item_optnames := breakup("activebackground,activeforeground,accelerator,background,foreground,bitmap,columnbreak,command,font,"
				+  "hidemargin,image,label,state,underline,indicatoron,offvalue,onvalue,variable,selectcolor,selectimage,value,menu",",");

		for j in [0..men_len] loop
			item_type := tk_kall(men_name + " type " + j);
			item_data := {["type",item_type]}
				 + {[optname,x]: optname in menu_item_optnames | 
						(x := reduce_unknowns(tk_kall(men_name + " entrycget " + j + " -" +  optname))) /= OM};
			
			data_tup with:= item_data;
		end loop;

		return data_tup;

	end read_whole_menu;

	procedure reduce_unknowns(att_stg);			-- replace 'unknown option' error messages by 'U'
		return if att_stg = "" or att_stg(#att_stg) /= "\"" then att_stg else OM end if;
	end reduce_unknowns;

	procedure configure_canvas_item(x,y);			-- configure a canvas item   
			-- Tk uses itemcget/itemconfigure calls to get/set all but the coords attributes, 
			-- but a coords calls to get/set the coords attribute. Note that x has already been broken into a tuple,
			-- but y has not

			-- The attributes of canvas items are: tags, width, and coords in all cases, plus 
				-- for canvas geometric objects: fill, outline, and stipple 
				-- for images: anchor and image 
				-- for canvas text objects: anchor, fill, font, justify, stipple, and text 
				-- for canvas widgets: anchor, height, and window
			-- x is a tuple of attributes; y can be a string, possibly semicolon-delimited
			-- with a comma-delimited list of coordinates, or can be a tuple, possibly
			-- including a comma or semicolon-delimited delimited string of coordinates, or
			-- a tuple of coordinates. 
			
		fn := parent.full_name();			-- get the full tk name of the parent canvas
		attr_list := x; 
-- print("configure_canvas_item: ",full_name()," ",x," ",y," ",fn);		
--		y := if #x = 1 then	[y] else chop(y) end if;
-- 				-- turn argument of any type into unit tuple, break string into list
		
		for att = attr_list(j) loop		-- loop, using the tk itemconfigure command to set the value
									-- unless the attribute is 'coords', in which case we use
									-- the parent coords command to set it
			if att = "coords" and #x = 1 and ((not is_string(y1 := y(1))) or not "," in y1) then 
				
				val := y;		-- use whole y as matching attrib value
			
			elseif is_procedure(y(j)) then
							-- call the tk library 'createcommand' function, to associate a 
							-- new command id of the form Pnnn with the SETL callback procedure supplied;
							-- then include the command id in the command string being built

				tk_createcommand(interp, val := "P" + str(proc_ctr +:= 1) ,y(j));
											-- we will include the callback id in the command being built
 
			else  		-- item should be a tk string value
 
				val := y(j);		-- include the string value in the command being built
 
			end if;

			if att = OM then		-- we bind a procedure to the canvas item
				
				op_name := main_command(tk_type);
				txt := parent.full_name() + " bind " + name(2..) +  " " + op_name + " " + val;	
--print("configure_canvas_item: ",txt," ",x," ",y," ",val," ",name," ",op_name);

			elseif att /= "coords" then

				txt := fn + " itemconfigure " + name(2..) +  " -" + att + " " + str(val);	
--print("configure canvas_item: ",txt); stop;
			else			-- a tuple of numbers or comma-delimited string is expected
				
				if is_string(val) and (nv := #val) > 0 and "{" = val(1) then val := val(2..nv - 1); end if;
				if is_string(val) and "," in val then val := chop(val); end if;
				txt := fn + " coords " + name(2..) + " " + "" +/ [str(d) + " ": d in val];	
--print("configure coords: ",txt," y: ",y," res: ",tk_kall(txt)); print("self(OM) is: ",self(OM));
			end if;

			res := tk_kall(txt);

		end loop;

	end configure_canvas_item;

 	procedure configure_file_item(fname,att_list,val_list);			-- configure a file item		
--print("configure_file_item: ",att_list,val_list);		
		if not is_tuple(att_list) then  att_list := [att_list]; end if;		-- force to tuple
		if not is_tuple(val_list) then  val_list := [val_list]; end if;		-- force to tuple
		
		for att = att_list(j) loop

			val := val_list(j);
			
			case att
			
				when "mac_creator" => 
					if is_string(val) and # val = 4 then tk_kall("file attributes " + fname + " -creator " + val); end if;

				when "mac_type" => 
					if is_string(val) and # val = 4 then tk_kall("file attributes " + fname + " -type " + val); end if;

				when "mac_hidden" => tk_kall("file attributes " + fname + " -readonly " + if val = 0 or val = "0" then "0" else "1" end if);

				when "mac_readonly" => tk_kall("file attributes " + fname + " -readonly " + if val = 0 or val = "0"  then "0" else "1" end if);

				when "name" => 

					if val = "" then  			-- delete the file
						
						tk_kall("file delete " + fname);

					elseif is_string(val) then 			-- rename the file,  or create a directory of the specifed name
						
						the_type := tk_kall("file type " + fname);		-- first determine if the file exists
						not_exists_msg := rmatch(the_type,"no such file or directory");
						not_exists := not_exists_msg /= "";

						if not_exists then			-- create a directory of the given name
							tk_kall("file mkdir " + val);
						else		-- rename the file
							tk_kall("file rename " + fname + " " + val);
						end if; 
	
					end if;

			end case;

		end loop;

	end configure_file_item;

 	procedure configure_socket_item(x,y);			-- configure a socket item		

	end configure_socket_item;

 	procedure configure_geometry(x,y);		-- handle geometry-manager calls
--print("configure_geometry: ",x,y); 	
 		case x(1)
 		
	 		when "pack" =>		-- ignore, but must be followed by pack options (pack geometry manager)
	 					
	 			if exists j in [2..#x] | x(j) notin pack_options then
	 				abort(str(x(j)) + " is not a legal option for a pack operation");
	 			end if;
	 					
	 			if #y /= #x - 1 then 
	 				abort("Different number of pack operation options and option values");
	 			end if;
	 					
	 			the_text := "pack " + full_name();
	 					
	 			for j in [2..#x] loop		-- now assemble the options and option values
	   				the_text +:= (" -" + x(j) + " \"" + str(y(j - 1)) + "\"");
	  			end loop;
	  					
	 		when "side" =>		-- must be followed by pack options (pack geometry manager)
	 					
	 			if exists j in [1..#x] | x(j) notin pack_options then
	 				abort(str(x(j)) + " is not a legal option for a pack operation");
	 			end if;
	 					
	 			if #y /= #x then 
	 				abort("Different number of pack operation options and option values " + str(x) + "\n" + str(y));
	 			end if;
	 					
	 			the_text := "pack " + full_name();
	 					
	 			for j in [1..#x] loop		-- now assemble the options and option values
	   				the_text +:= (" -" + x(j) + " \"" + str(y(j)) + "\"");
	  			end loop;
	 			
	 		when "grid" =>		-- ignore, but must be followed by grid options  (grid geometry manager)
	  					
	 			if exists j in [2..#x] | x(j) notin grid_options then
	 				abort(str(x(j)) + " is not a legal option for a grid operation");
	 			end if;
	 					
	 			if #y /= #x - 1 then 
	 				abort("Different number of grid operation options and option values");
	 			end if;
	 					
	 			the_text := "grid " + full_name();
	 					
	 			for j in [2..#x] loop		-- now assemble the options and option values
	   				the_text +:= (" -" + x(j) + " \"" + str(y(j - 1)) + "\"");
	  			end loop;
	
	 		when "row","column" =>		-- must be followed by grid options  (grid geometry manager)
	 					
	 			if exists j in [1..#x] | x(j) notin grid_options then
	 				abort(str(x(j)) + " is not a legal option for a grid operation");
	 			end if;
	 					
	 			if #y /= #x then 
	 				abort("Different number of grid operation options and option values" + str(x) + "\n" + str(y));
	 			end if;
	 					
	 			the_text := "grid " + full_name();
	 					
	 			for j in [1..#x] loop		-- now assemble the options and option values
	   				the_text +:= (" -" + x(j) + " \"" + str(y(j)) + "\"");
	  			end loop;
	 			
	 		when "place" =>		-- but must be followed by place options  (place geometry manager)
	  					-- example is obj("place,x,y,anchor") := "xv,yv,nw";
	  					
	 			if exists j in [2..#x] | x(j) notin place_options then
	 				abort(str(x(j)) + " is not a legal option for a place operation");
	 			end if;
	 					
	 			if #y /= #x - 1 then 
	 				abort("Different number of place operation options and option values" + str(x) + "\n" + str(y));
	 			end if;
	 					
	 			the_text := "place " + full_name();
	 					
	 			for j in [2..#x] loop		-- now assemble the options and option values
	   				the_text +:= (" -" + x(j) + " \"" + str(y(j - 1)) + "\"");
	  			end loop;

		end case;
		res := tk_kall(the_text);
--print("configure_geometry: ",res," ",the_text);

		return res;		-- we finish the operation here
				
	end configure_geometry;
 	
 	procedure configure_geometry_in(x,y,in_widget);			-- handle extended geometry-manager calls
 	
 		in_widget_name := in_widget.full_name();	-- get the full name of the widget which will become the container
 		
 		case x(1)
 		
	 		when "pack" =>		-- ignore, but must be followed by pack options (pack geometry manager)
	 					
	 			if exists j in [2..#x] | x(j) notin pack_options then
	 				abort(str(x(j)) + " is not a legal option for a pack operation");
	 			end if;
	 					
	 			if #y /= #x - 1 then 
	 				abort("Different number of pack operation options and option values");
	 			end if;
	 					
	 			the_text := "pack " + full_name();
	 					
	 			for j in [2..#x] loop		-- now assemble the options and option values
	   				the_text +:= (" -" + x(j) + " \"" + y(j - 1) + "\"");
	  			end loop;
	  					
	 		when "side" =>		-- must be followed by pack options (pack geometry manager)
	 					
	 			if exists j in [1..#x] | x(j) notin pack_options then
	 				abort(str(x(j)) + " is not a legal option for a pack operation");
	 			end if;
	 					
	 			if #y /= #x then 
	 				abort("Different number of pack operation options and option values " + str(x) + "\n" + str(y));
	 			end if;
	 					
	 			the_text := "pack " + full_name();
	 					
	 			for j in [1..#x] loop		-- now assemble the options and option values
	   				the_text +:= (" -" + x(j) + " \"" + y(j) + "\"");
	  			end loop;
	 			
	 		when "grid" =>		-- ignore, but must be followed by grid options  (grid geometry manager)
	  					
	 			if exists j in [2..#x] | x(j) notin grid_options then
	 				abort(str(x(j)) + " is not a legal option for a grid operation");
	 			end if;
	 					
	 			if #y /= #x - 1 then 
	 				abort("Different number of grid operation options and option values");
	 			end if;
	 					
	 			the_text := "grid " + full_name();
	 					
	 			for j in [2..#x] loop		-- now assemble the options and option values
	   				the_text +:= (" -" + x(j) + " \"" + y(j - 1) + "\"");
	  			end loop;
	
	 		when "row","column" =>		-- must be followed by grid options  (grid geometry manager)
	 					
	 			if exists j in [1..#x] | x(j) notin grid_options then
	 				abort(str(x(j)) + " is not a legal option for a grid operation");
	 			end if;
	 					
	 			if #y /= #x then 
	 				abort("Different number of grid operation options and option values" + str(x) + "\n" + str(y));
	 			end if;
	 					
	 			the_text := "grid " + full_name();
	 					
	 			for j in [1..#x] loop		-- now assemble the options and option values
	   				the_text +:= (" -" + x(j) + " \"" + y(j) + "\"");
	  			end loop;
	 			
	 		when "place" =>		-- but must be followed by place options  (place geometry manager)
	  					-- example is obj("place,x,y,anchor") := "xv,yv,nw";
	  					
	 			if exists j in [2..#x] | x(j) notin place_options then
	 				abort(str(x(j)) + " is not a legal option for a place operation");
	 			end if;
	 					
	 			if #y /= #x - 1 then 
	 				abort("Different number of place operation options and option values" + str(x) + "\n" + str(y));
	 			end if;
	 					
	 			the_text := "place " + full_name();
	 					
	 			for j in [2..#x] loop		-- now assemble the options and option values
	   						the_text +:= (" -" + x(j) + " \"" + y(j - 1) + "\"");
	  			end loop;

		end case;

		res := tk_kall(txt := the_text + " -in " + in_widget_name);		-- we finish the operation here
--print("configure_geometry_in: ",res," ",txt);
 		return res;
 		
	end configure_geometry_in;

	procedure handle_pseudo_attrib(name,xj,yj); 		-- handle special widget configuration ops
 	
 		case tk_type
 		
 		when "entry" =>			-- special action for the 'insert' pseudo-attribute
 			
 			if xj /= "insert" then return false; end if;
  			tk_kall(full_name() + " icursor " + str(yj));
 									-- special action for the 'insert' pseudo-attribute; note that this is not
 									-- possible for text widgets
   			return true;		-- done with this case
 		
 		when "canvas_text" =>		-- special action for the 'insert' pseudo-attribute
 
			if xj /= "insert" then return false; end if;
    		tk_kall(parent.full_name() + " icursor " + name(2..) + " " + str(yj));
  							
   			return true;		-- done with this case
 		
 		when "radiobutton","checkbutton" =>		-- special action for the 'selected' pseudo-attribute
 			
 			if xj /= "selected" then return false; end if;
 												-- else is pseudo-attribute: set the associated variable
			if str(yj) = "1" then tk_kall(full_name() + " select "); else tk_kall(full_name() + " deselect "); end if;
			return true;			-- done with this case

-- 		when "checkbutton" =>		-- special action for the 'selected' pseudo-attribute
--			
-- 			if xj /= "selected" then return false; end if;
-- 												-- else is pseudo-attribute: set the associated variable
--			varname := tk_kall(full_name() + " cget -variable ");		-- get name of associated variable
--			tk_kall("set " + varname + " " + str(yj));
--			return true;			-- done with this case

 		when "listbox" =>			-- special action for the 'hilight' pseudo-attribute
									-- set the associated variable
			if xj /= "hilight" then return false; end if;
			txt := full_name() + " activate " + str(yj); 
			tk_kall(txt);
			
			return true;			-- done with this case

 		otherwise => 

			if xj /= "coords" then return false; end if;
 
 												-- the "coords" case must be handled specially
 			yy := breakup(yj,","); 
 			coord_text := parent.full_name() + " coords " + name(2..) + " " +/ [str(xx) + " ": xx in yy];
  			tk_kall(coord_text);	-- execute the 'coords' command
  
   			return true;		-- done with this case

		end case;	

 	end handle_pseudo_attrib;					

	procedure may_quote(stg);	-- quote a string if not enclosed in curly brackets
		return if #stg > 0 and stg(1) /= "{" then "\"" + stg + "\"" else stg end if;
	end may_quote;

	procedure tk_string_of(obj_or_proc);	-- find appropriate name for tk widget, image, or procedure
		-- convert a SETL procedure to a tk command name if none yet issued; use full names for objects other
		-- than absolute images; and use the simple name for images

		if obj_or_proc = "" then return "{}"; end if;			-- Tk form of nullstring
		
		if type(obj_or_proc) = "TKW" then
													-- check for the absolute image case
			if obj_or_proc.tk_type in {"image","bitmap"} and obj_or_proc.parent = OM then return obj_or_proc.name; end if;
			
			return obj_or_proc.full_name(); 	-- use full name if this is a Tk widget

		end if;

		if type(obj_or_proc) /= "PROCEDURE" then return str(obj_or_proc); end if;		-- simply convert to string if not procdure
		
		if (pid := proc_tk_name(obj_or_proc)) /= OM then return pid; end if;
						-- procedure has already been given a tk_name; return this 

		
		proc_tk_name(obj_or_proc) := (pid := "P" + str(proc_ctr +:= 1));		-- otherwise give it a new name
		tk_createcommand(interp,pid,obj_or_proc);				-- make this name into a tk command

		return pid;		-- return the new name 
		
	end tk_string_of;

	procedure beeper();				-- beep procedure
		tk_call(interp,"beep");
	end beeper;

	procedure stopper();			-- destruction of top level window to force return from Tk main loop
		tk_call(interp,"destroy .");
	end stopper;

	procedure place();			-- returns object x and y coordinates if 'placed' in parent
		return [unstr((self("place")("x"))?"-9999"),unstr((self("place")("y"))?"-9999")];
	end place;

	procedure gridbox(i,j);				-- returns coordinates  of specified gridbox 
		txt := "grid bbox " + full_name() + " " + i + " " + j; return tk_call(interp,txt);
	end gridbox;

	procedure raise(after_obj);		-- raises object to position just after after_obj, or to top if after_obj = OM

		if name = "" then return; end if;		-- this should not happen
			 
		if name(1) = "w" then		-- raising a widget
			txt := "raise " + self.full_name();
			if after_obj /= OM then txt +:= (" " + after_obj.full_name()); end if;
		else
		  	txt := if parent = OM then "raise ." else parent.full_name() + " " + "raise " + name(2..) end if;
			if after_obj /= OM then txt +:= (" " + (after_obj.name)(2..)); end if;
		end if;

		tk_call(interp,txt);

	end raise;

	procedure lower(before_obj);	-- lowers object to position just before before_obj, or to bottom if before_obj = OM
		if name = "" then return; end if;		-- this should not happen
			 
		if name(1) = "w" then		-- raising a widget
			txt := "lower " + self.full_name();
			if before_obj /= OM then txt +:= (" " + before_obj.full_name()); end if;
		else
		  	txt := if parent = OM then "lower ." else parent.full_name() + " " + "raise " + name(2..) end if;
			if after_obj /= OM then txt +:= (" " + (after_obj.name)(2..)); end if;
		end if;
	
		tk_kall(txt);

	end lower;

	procedure createtimer(interval,SETL_fun);		-- create a timer callback (rings once)
		pid := tk_string_of(SETL_fun);
		txt := "after " + if interval = OM then "idle" else str(interval) end if + " " + pid;
		return tk_kall(txt);
--		return if interval = OM then tk_idlecallback(SETL_fun) else tk_createtimer(interval,SETL_fun) end if;
	end createtimer;

	procedure cancel_event(id);		-- cancel a timer or idle callback
		return tk_kall("after cancel " + id);
--		return tk_destroy(id);
	end cancel_event;

	procedure break_event();		-- suppress further processingof an  event
		return tk_kall("break");
	end break_event;

	-- ****** Operations available for all widgets ******

	procedure bindtags(tag);		-- gets event bindings for specified tag, or for whole widget if tag = OM
		if tag /= OM then return tk_kall("bind " + tag); end if;
		return tk_kall("bindtags " + full_name());
	end bindtags;

--	procedure virt_event_info(virt_event);		-- gets physical definition of specified virtual events, or virtual event list if param is OM
--		return tk_kall("event info " + virt_event?""); 
--	end virt_event_info;

	procedure virt_event_delete(virt_event);		-- deletes specified virtual event
		return tk_call(interp,"event delete " + virt_event); 
	end virt_event_delete;


	-- ****** Basic Operationss ******

	procedure quit();						-- close the tk interpreter
		tk_call(interp,"destroy .");		-- by destroying the top window
		tk_quit(interp);					-- and then calling the native package
	end quit;

	procedure call(txt);			-- transmit a command to the tk main loop
		return tk_kall(txt);
	end call;

	procedure mainloop();			-- call the tk main loop and wait for callback
		return tk_mainloop(interp);
	end mainloop;

		-- GIUSEPPE START
	procedure handle_event();			-- call the tk event and handle the callbacks
		return tk_handle_event(interp);
	end handle_event;

	procedure get_event_source_function();			-- call the tk main loop and wait for callback
		return tk_get_event_source_function(); 			-- interp);		-- ?????
	end get_event_source_function;
		-- GIUSEPPE END

	procedure setvar(name,val);		-- set a tk variable to the indicated value
		txt := "set " + name + " \"" + stg_to_Tk(str(val)) + "\"";  
		return tk_kall(txt);
	end setvar;

	procedure getvar(name);			-- read a tk variable
		txt := "set " + name; return tk_kall(txt);
	end getvar;

	procedure update();			-- request screen display update
		txt := "update"; tk_kall(txt);
	end update;

	-- ****** Miscellaneous Utilities ******
	procedure clock();	-- clock and date utility
		-- returns time in format [very_fine,seconds,dau,month,am_pm,weekno_in_year,mm/dd/yy,abbrev_time,monthno,dayno_in_year,dayno_in_week]
		ticks := tk_kall("clock clicks"); secs := tk_kall("set x [clock seconds]"); 
		timetup := [unstr(ticks),unstr(secs)] + breakup(tk_kall("clock format $x -format %A%%%B%%%p%%%U%%%x%%%c%%%j%%%w"),"%"); 
		
		return timetup;
	end clock;

	-- ****** Canvas Operations ******

	procedure addtag_after(tag);	
								-- add a specified tag to the item just above (or below) that with a 
								-- given tag in the display list, or to all items, or to all enclosed
								-- in a given rectangle, or to the nearest item to a given point, 
								-- or to items which already have a given tag.
		txt := parent.full_name() + " addtag \"" + tag + "\" above " + name(2..); 
--print("addtag_before: ",txt);
		return tk_kall(txt);
	end addtag_after;

	procedure addtag_before(tag);	-- 'add tag below' case; see preceding comment
		txt := parent.full_name() + " addtag \"" + tag + "\" below " + name(2..); 
		return tk_kall(txt);
	end addtag_before;

	procedure addtag_in(tag,rect);	-- add tag to all items in a rectangle, or to all items if rect is OM
		if rect = OM then 
			txt := full_name() + " addtag \"" + tag + "\" all"; return tk_kall(txt);
		end if;
		
		rect := "" +/ [str(x) + " ": x in chop(rect)]; 
		txt := full_name() + " addtag \"" + tag + "\" enclosed " + rect; 
		return tk_kall(txt);

	end addtag_in;

	procedure addtag_nearest(tag,xy,halo,start);	-- nearest to x,y, or last within radius halo of x,y, or
													-- first such after item start in the canvas display list
		[x,y] := breakup(xy,",");
		txt := full_name() + " addtag \"" + tag + "\" closest " + x + " " + y; 
		if halo /= OM then txt +:= (" " + str(halo)); end if;
		if start /= OM then txt +:= (" " + str(start)); end if;
		return tk_kall(txt);
	end addtag_nearest;

	procedure addtag_if(newtag,hastag);	
		txt := full_name() + " addtag \"" + newtag + "\" withtag \"" + hastag + "\""; 
		return tk_kall(txt);
	end addtag_if;

	procedure addtag(newtag);				-- add new tag to a canvas item 		
		txt := parent.full_name() + " addtag \"" + newtag + "\" withtag " + name(2..); 
		return tk_kall(txt);
	end addtag;

	procedure bbox_tags(tags);	-- get bounding box of items with given tags or ids
		txt := full_name() + " bbox "  +/ ["\"" + tag + "\" ": tag in chop(tags)]; 
		return tk_kall(txt);
	end bbox_tags;

	procedure canvasx(x,roundto);		-- map from screen to canvas coordinates, possibly rounded to grid units
		txt := full_name() + " canvasx "  + str(x) + " " + if roundto /= OM then str(roundto) 
						else "" end if;
		return unstr(tk_kall(txt));
	end canvasx;

	procedure canvasy(y,roundto);		-- map from screen to canvas coordinates, possibly rounded to grid units
		txt := full_name() + " canvasy "  + str(y) + " " + if roundto /= OM then str(roundto) 
						else "" end if;
		return unstr(tk_kall(txt));
	end canvasy;

	procedure delete();	-- delete a canvas item

		if tk_type notin canvas_items then return; end if;
		txt := parent.full_name() + " delete " + name(2..); 
		return tk_kall(txt);

	end delete;

	procedure delete_till(end_ci);	-- delete a range of canvas items

		if tk_type notin canvas_items then return; end if;
		
		first_no := unstr(name(2..)); last_no := unstr(end_ci.name(2..));
		pfn_d := parent.full_name() + " delete ";
		
		for itm_no in [first_no,first_no + 10..last_no - 10] loop
			txt := "" +/ [pfn_d + str(itm_no + j) + "\n": j in [0..9]]; 
			tk_kall(txt);				-- delete a block of 10 items
			last_del := itm_no + 10;			-- keep track
		end loop;

		txt := "" +/ [pfn_d + str(j) + "\n": j in [last_del..last_no]]; 			-- delete the final group
		return tk_kall(txt);

	end delete_till;

	procedure draw_ovals(descriptor_tup);	-- draw a group of ovals; callsed as ca.draw_ovals(descriptor_tup), ca must be canvas
		-- each descriptor_tup section is a pair of the form ['ulx,uly,lrx,lry',fill]. 
		-- This should return the first and the last oval drawn
		fnco := (fn := full_name()) + " create oval ";		-- prefix for first part of call
		fnic := fn + " itemconfigure ";						-- prefix for second part of call
		
		txt := fnco + join(breakup(descriptor_tup(1)(1),",")," ");		-- set up to create the first oval, whose Tk serial number will be needed
		res := tk_kall(txt);
		item_num := first_num := unstr(res) - 1;  		-- get the number of the first item created

		txt := "" +/ [if j = 1 then "" else fnco + join(breakup(koords + "\n",",")," ") end if 
								+ fnic + str(item_num +:= 1) + " -fill " + color + "\n": 
							[koords,color] = descriptor_tup(j)];
--print("draw_ovals: ",txt); 
		res := tk_kall(txt);

		return [item_from_itemno(self,first_num),item_from_itemno(self,item_num)]; 			-- the first and the last oval drawn
		
	end draw_ovals;

	procedure delete_items(tags_or_ids);	-- remove the item(s) identified  by an id or tag

		txt := full_name() + " delete " +/ ["\"" + tid + "\" ": tid in chop(tags_or_ids)]; 
		return tk_kall(txt);

	end delete_items;

	procedure deltag_if(iftag,tags_or_ids);	-- remove the specified tag from the item(s) identified  by an id or tag
		txt := full_name() + " dtag " + "\"" + iftag + "\" " +/ ["\"" + tid + "\" ": tid in chop(tags_or_ids)]; 
		return tk_kall(txt);
	end deltag_if;

	procedure get_tagindex(tag,index);		-- gets the value of an index in a tagged canvas text item

		if tk_type /= "canvas" then return "Not a canvas!"; end if;			--  must be a canvas  text item
		txt := full_name() + " index " + tag + " " + index; 

		return unstr(tk_kall(txt)) + 1;

	end get_tagindex;

	procedure get_select(tag);				-- gets the value of sel.first and  sel.last in a tagged canvas text item 

		if tk_type /= "canvas" then return "Not a canvas!"; end if;			--  must be a canvas  text item
		txt := full_name() + " index " + tag + " sel.first"; 
		if (sf := tk_kall(txt))(1) = "s" then 	-- use  the insert position if the  selection is empty
			txt := full_name() + " index " + tag + " insert"; 
			return [(res := unstr(tk_kall(txt))) + 1,res]; 			-- done with this case
		end if;
				
		txt := full_name() + " index " + tag + " sel.last";  sl := tk_kall(txt);
		return [unstr(sf) + 1,unstr(sl) + 1];

	end get_select;

	procedure set_select(tag,i,j);			-- sets the value of sel.first and  sel.last in a tagged canvas text item 

		if tk_type /= "canvas" then return "Not a canvas!"; end if;			--  must be a canvas  text item

		if j = i - 1 then 				--  clear the  selection and set the  insertion point
			txt := full_name() + " select clear"; tk_kall(txt); 
			txt := full_name() + " icursor " + tag + " " + str(j); 
			return tk_kall(txt); -- done with this case
		end if;
		
		txt := (fn  := full_name()) + " select from " + tag + " " + str(i - 1); tk_kall(txt);
		txt := fn + " select to " + tag + " " + str(j - 1); tk_kall(txt);

		return tk_kall(txt);

	end set_select;

	procedure refocus(tag);					-- sets the focus to a tagged canvas text item, or gets it if tag = OM 

		if tk_type /= "canvas" then return "Not a canvas!"; end if;			--  must be a canvas  text item
		fn := full_name();
		if tag = OM then return tk_kall(fn + " focus"); end if;			-- in this case, read the focus

--		res := tk_kall(txt1 := "focus " + fn);					-- the canvas must get the focus,to assign it to a tag

		txt := fn + " focus " + tag;  res := tk_kall(txt);			

		return res;

	end refocus;

	procedure deltag(tags_or_ids);				-- remove the specified tags from a canvas item 
		
		for tid in chop(tags_or_ids) loop
			txt := parent.full_name() + " dtag " + name(2..) + " \"" + tid + "\"";
			tk_kall(txt);
		end loop;
		
	end deltag;

	procedure find_after();	-- find the item just above that with a given tag in the display list,
								-- or all items, or all enclosed in a given rectangle, or the 
								-- nearest item to a given point, or to items which already have a given tag.	
		txt := parent.full_name() + " find above " + name(2..); 
		if (item_no := tk_kall(txt)) = "" then return OM; end if;
		return item_from_itemno(parent,item_no);
	end find_after;

	procedure find_before();	-- find the item just below that with a given tag in the display list,
		txt := parent.full_name() + " find below " + name(2..); 
		if (item_no := tk_kall(txt)) = "" then return OM; end if;
--print(txt," ",item_no); return OM;
		return item_from_itemno(parent,item_no);
	end find_before;

	procedure find_in(rect);	-- find all the items enclosed in a given rectangle
		if rect = OM then 
			txt := full_name() + " find all"; 
			item_list := breakup(tk_kall(txt)," ");		-- get the list of items
			return [item_from_itemno(self,item_no): item_no in item_list];
		end if;
		
		rect := "" +/ [str(x) + " ": x in chop(rect)]; 
		txt := full_name() + " find enclosed " + rect; 
		item_list := breakup(tk_kall(txt)," ");		-- get the list of items
		
		return [item_from_itemno(self,item_no): item_no in item_list];
	end find_in;

	procedure find_touching(rect);	-- find all the items touching in a given rectangle
		if rect = OM then 
			txt := full_name() + " find all"; 
			item_list := breakup(tk_kall(txt)," ");		-- get the list of items
			return [item_from_itemno(self,item_no): item_no in item_list];
		end if;
		
		rect := "" +/ [str(x) + " ": x in chop(rect)]; 
		txt := full_name() + " find overlapping " + rect; 
		item_list := breakup(tk_kall(txt)," ");		-- get the list of items

		return [item_from_itemno(self,item_no): item_no in item_list];
	end find_touching;

	procedure find_nearest(xy,halo,start);	-- find the nearest item to a given point
		txt := full_name() + " find " + " closest " + str(i) + " " + str(j); 
		if halo /= OM then txt +:= (" " + str(halo)); end if;
		if start /= OM then txt +:= (" " + str(start)); end if;
		item_no := tk_kall(txt);		-- get the number of the item
		
		return item_from_itemno(self,item_no);		-- convert the item number to an item

	end find_nearest;
	
	procedure find(tag);		-- find all the items having a given tag
		txt := full_name() + " find withtag \"" + tag + "\""; 

		item_list := breakup(tk_kall(txt)," ");		-- get the list of items
		return [item_from_itemno(self,item_no): item_no in item_list];
	end find;
	
	procedure item_from_itemno(parnt,item_no);		-- convert an item number to an item
	
		new_item := tkw();					-- form a blank new (canvas or text) item
		new_item.parent := parnt;			-- set the parent
		new_item.tk_type := kind_from_config(parnt,item_no := str(item_no));		-- find its type
		new_item.name := "c" + item_no;		-- note its serial number  (prefixing a 'c')			
				
		return new_item;

	end item_from_itemno;

	procedure kind_from_config(parnt,item_no);		-- find the type of a canvas object from its configuration
		-- this routine examines the attributes of an object to determine its tk_type, using the following heuristic:
		-- an arc has 'extent'; a window has 'window'; an image has 'image'; a bitmap has 'bitmap'; a line has
		-- 'arrow' and 'smooth'; a polygon has 'smooth' but not 'arrow'; text has 'font'. the other two cases are
		-- oval and rectangle, which we distinguish using tags assigned when created.
		
		txt := parnt.full_name() + " itemconfigure " + item_no;
		info := tk_kall(txt);		-- get the configuration info

		key_att := find_wds(info,key_attributes)(2);
--print("kind_from_config: ",info," ",item_no);
		case key_att
		
			when "extent" => return "arc";
		
			when "window" => return "widget";
		
			when "image" => return "image";
		
			when "bitmap" => return "bitmap";
		
			when "font" => return "canvas_text";
		
			when "smooth" => return if #find_wds(info,["arrow"]) = 0 then "polygon" else "line" end if;
		
			otherwise => 
				
				info := tk_kall(txt + " -tags");
				return if #find_wds(info,["OVAL"]) > 0 then "oval" else "rectangle" end if;
			
		end case;

	end kind_from_config;

	procedure find_wds(in_stg,wd_list);		-- find the first word in wd_list which occurs in wd_list, if any
									-- return the pair [location,wd]; or [] if none 
		fronts := "" +/domain(wff := {[wd(1),wd(2..)]: wd in wd_list | #wd > 0});
		loc := 1;		-- we keep track of our location in the following scan
	
		while in_stg /= "" loop
	
			skipped := break(in_stg,fronts); 	-- advance to the next significant character
			fc := any(in_stg,fronts); 			-- find what it is
			loc +:= # skipped;				-- note number of characters bypassed
	
			if fc = "" then exit; end if; 		-- exit if at end
	
			for wd_tail in wff{fc} loop		-- check to see if we have one of the words sought
	
				if match(in_stg,wd_tail) /= "" then 		-- found what we want
					return [loc,fc + wd_tail];
				end if;
				
				loc +:= 1;					-- note one more character bypassed
	
			end loop;
	
		end loop;
			
		return [];				-- otherwise not found
	
	end find_wds;

	procedure focus();			-- return widget in win which has the focus
		txt := "focus -displayof " + full_name(); return obj_from_tkname(tk_kall(txt));
	end focus;

	procedure focus_in_top();	-- return widget in master window which has the focus
		txt := "focus -lastfor " + full_name(); return obj_from_tkname(tk_kall(txt));
	end focus_in_top;

	procedure get_focus();		-- set focus to this window
		txt := "focus -force " + full_name(); return tk_kall(txt);
	end get_focus;

	procedure grab_focus(x);	-- grab the (modal) focus; x can be OM or "global"
		txt := "grab " + if x = OM then "" else "-global " end if + full_name(); 
		return tk_kall(txt);
	end grab_focus;

	procedure release_focus();	-- release the (modal) focus
		txt := "grab release " + full_name(); return tk_kall(txt);
	end release_focus;

	procedure read_grab();		-- determine the modal grab state of this window: none, local, or global
		txt := "grab status " + full_name(); return tk_kall(txt);
	end read_grab;

	procedure grabber();		-- return window which has exerted a grab
		txt := "grab current " + full_name(); return tk_kall(txt);
	end grabber;

	procedure destroy();		-- destroy a widget
		txt := "destroy " + full_name(); 
--print("destroy: ",txt);
		return tk_kall(txt);
	end destroy;

	procedure wait();			-- wait for this window to open
		txt := "tkwait visibility"; return tk_kall(txt);
	end wait;

	procedure wait_close();		-- wait for this window to be destroyed
		txt := "tkwait window"; return tk_kall(txt);
	end wait_close;

	procedure waitvar(name);		-- wait for the specified tk variable to change
		txt := ""; return tk_kall(txt);
	end waitvar;

	procedure index_item(ix_key);	-- get numerical value of index_key, which can be active, end, last, etc.
		txt := parent.full_name() + " index \"" + name(2..) + "\" " + ix_key; 
		return tk_kall(txt);
	end index_item;

	procedure lower_tid(tag_or_id,be);	-- lower the item identified by an id or tag either to  specified level,
						 		-- or to the start of the display list
		txt := full_name() + " lower \"" + tag_or_id + "\" " + if be = OM then "" else 
								"\"" + be + "\"" end if; 
		return tk_kall(txt);
	end lower_tid;

	procedure move(tag_or_id,dx,dy);	-- move the item(s) identified  by an id or tag, a specified amount
		txt := full_name() + " move \"" + tag_or_id + "\" " + str(dx) + " " + str(dy);
		return tk_kall(txt);
	end move;

	procedure postscript(options);	-- generate postscript for the contents of a canvas. See below for options available
		cfn := full_name();
		txt := cfn + " postscript " + handle_ps_options(options,cfn); 
		return tk_kall(txt);
	end postscript;

	procedure handle_ps_options(options,cfn);		-- convert comma-delimited postscript options into tk form
		-- the postscript options available are" colormap (map from color indices into colors), 
		-- colormode (color, gray, or mono), file (file_name), height (of area to print), width (of area to print), 
		-- x (left of area to print), y (top of area to print), rotate (true if paper should be turned 90 degrees), 
		-- fontmap (map from X font names into Postscript fonts and sizes), pageheight (of output area), 
		-- pagewidth (of output area), pagex (left of output area), pagey (top of output area), 
		-- pageanchor (c, n,e,s, w, ne, se, nw, or sw); point from which output area offset is measured

		options := breakup(options?"",",;");				-- break into list
		option_names := {option: option = options(j) | odd(j)};
		options_string := "";

		if "width" notin option_names then
			options_string +:= " -width " + tk_kall(cfn + " cget -width");
		end if;

		if "height" notin option_names then
			options_string +:= " -height " + tk_kall(cfn + " cget -height");
		end if;
		
		return options_string +/[if odd(j) then " -" else " " end if + option: option = options(j)];

	end handle_ps_options;
	
	procedure raise_tid(tag_or_id,ab);	-- raise the item identified by an id or tag either to  speicified level,
								-- or to the end of the display list
		txt := full_name() + " raise \"" + tag_or_id + "\" " + if be = OM then "" else "\"" + ab + "\"" end if; 
		return tk_kall(txt);
	end raise_tid;

	procedure scale_item(cent_x,cent_y,amt_x,amt_y);
								-- scale the item(s) identified  by an id or tag, by a specified amount
								-- about a specified center
		txt := parent.full_name() + " scale \"" + name(2..) + "\" " + 
			str(cent_x) + " " + str(cent_y) + " " + str(amt_x) + " " + str(amt_y); 
		return tk_kall(txt);
	end scale_item;

	procedure scan_mark(x,y);		-- place mark indicating scroll position???
		txt := full_name() + " scan mark " + str(x) + " " + str(y); 
		return tk_kall(txt);
	end scan_mark;

	procedure scan_to(x,y);		-- scroll to indicated position
		txt := full_name() + " scan dragto " + str(x) + " " + str(y); 
		return tk_kall(txt);
	end scan_to;

	procedure scan_mark_1(x);	-- place mark indicating scroll position
		txt := full_name() + " scan mark " + str(x);
		return tk_kall(txt);
	end scan_mark_1;

	procedure scan_to_1(x);		-- scroll to indicated position
		txt := full_name() + " scan dragto " + str(x);
		return tk_kall(txt);
	end scan_to_1;


	procedure canvas_select();			-- ???
		txt := ""; return tk_kall(txt);
	end canvas_select;

	procedure xview_percent(p);	-- move to place fraction p of string offscreen to the left; p is real
		txt := full_name() + " xview moveto " + str(p); return tk_kall(txt);
	end xview_percent;

	procedure yview_percent(p);	-- move to place fraction p of string offscreen to the top; p is real
		txt := full_name() + " yview moveto " + str(p); return tk_kall(txt);
	end yview_percent;

	procedure xview_scroll(n,what);	-- scroll horizontally, n 'units' or 'pages'
		txt := full_name() + " xview scroll " + str(n) + " " + (what?"units"); 	-- 'what' can be 'units' or 'pages'
		return tk_kall(txt);
	end xview_scroll;

	procedure yview_scroll(n,what);	-- scroll vertically, n 'units' or 'pages'
		txt := full_name() + " yview scroll " + str(n) + " " + (what?"units"); 	-- 'what' can be 'units' or 'pages'
		return tk_kall(txt);
	end yview_scroll;

	procedure image_of(rect);	-- capture the contents of a rectangle within a canvas, as a Tk absolute image

		if rect = OM then 			-- no rectangle
			img_name := tk_kall("image create mimage -canvas " + full_name());	-- call Tk to create the image
		else
			[l,t,r,b] := rect;		-- unpack
			txt := "image create mimage -canvas " + full_name() + " ";
			txt +:= "-canvas_x " + str(l) + " -canvas_y " +  str(t) + " -canvas_width " + 
						str(r - l) + " -canvas_height " + str(b - t);
			img_name := tk_kall(txt);
		end if;
		
--print("orig image_name and info: ",img_name," ",tk_kall(img_name + " cget -format"));
		
		photo_img_name := tk_kall("image create photo -height 100 -width 100 "); print("photo_img_name: ",photo_img_name);
		res := tk_kall(photo_img_name + " copy " + img_name); print("photo_img_name res: ",res);
		new_image := tkw();					-- form a blank new object
		new_image.parent := OM;				-- images have no parent
		new_image.tk_type := "image";		-- note its type
		new_image.name := photo_img_name;			-- note its name, which we make unique
								
		return new_image; 

	end image_of;

	-- ****** Text Widget Operations ******

	procedure compare(op,ix1,ix2);	-- compare character indices in line.char and other allowed formats
	-- op may be "==", ">", "!=", etc.
		op := if op = "=" then "==" elseif op = "/=" then "!=" else op end if;
		txt := full_name() + " compare {" + ix1 + "} " + op + " {" + ix2 + "}";
		return tk_kall(txt) = "1";
	end compare;

	procedure debug(on_off);			-- enable  consistency checking for B-tree code???
		txt := full_name() + " debug " + if on_off = OM then "false" else on_off end if; 
		return tk_kall(txt);
	end debug;

	procedure insert_tt(n,chars_and_tags);			
								-- insert a substring; this can carry specified tags in designated subsections

		chars_and_tags := breakup(chars_and_tags,"`");
		
		txt := full_name() + " insert " + str(n);
		
		for ct = chars_and_tags(j) loop		-- build the sanitized string of chars and tags
			txt +:= if odd(j) then " \"" + stg_to_Tk(ct) + "\"" 
				else " {" + join(breakup(ct,",")," ") + "}" end if;
		end loop;
--print("insert_tt: ",txt);		
		return tk_kall(txt);
		
	end insert_tt;
	
	procedure linebox(n);		-- return bounding box and baseline of line n
		txt := full_name() + " dlineinfo " + str(n) + ".0"; 
		data := [unstr(x): x in breakup(tk_kall(txt)," ")];
		[l,t,w,h] := data;
		return [[l,t,l + w,t + h],data(5)];
	end linebox;

	procedure insert_image(n,img); 		-- insert an image at a specified text position
		txt := full_name() + " image create " + n + " -image " + img.name; 
--print("insert_image: ",txt,img);
		return tk_kall(txt);
	end insert_image;

	procedure handle_image_options(options_values);		-- convert comma-delimited image options into tk form
							-- options are align (), image (), name (), padx (), pady ()
		return "" +/ [if odd(j) then "-" else "\"" end if + 
					if is_string(ov) then ov else ov.name end if		-- if the value is an image, use its name
										+ if odd(j) then " " else "\" " end if: ov = options_values(j)];
	end handle_image_options;

	procedure images();			-- return the ordered list of all images in a text widget
		txt := full_name() + " image names"; img_list := breakup(tk_kall(txt)," ");
		img_set := { };

		for img_name in img_list loop
			if "#" in img_name then rbreak(img_name,"#"); rmatch(img_name,"#"); end if;
			img_set with:= img_name;
		end loop; 
		
		img_list := [ ];

		for img_name in img_set loop
					
			new_image := tkw();					-- form a blank new object
			new_image.parent := OM;				-- images have no parent
			new_image.tk_type := if #img_name > 3 and img_name(1..4) = "XBM`" then "bitmap" else "image" end if;			-- note its type
			new_image.name := img_name;
			img_list with:= new_image;
			
		end loop; 
		
		return img_list;
		
	end images;

	procedure index(ix_stg);	-- return character position of specified text index
								-- this operation also applies to menus, entries, and listboxes
		-- text indices can be "current" (char under mouse), "end", "insert" (insert position),
		-- line.char, image (name), widget (name), mark (stg), tag_name.first, tag_name.last,

		case tk_type
		
			when "listbox","menu" => 
	
				if ix_stg = "sel.anchor" then	-- add 1 except for "sel.last" and "end"
					txt := full_name() + " index anchor"; return unstr(tk_kall(txt)) + 1;
				else
					txt := full_name() + " index " + ix_stg; 
					return unstr(tk_kall(txt)) + 1;
				end if;
					
			when "entry" => 
	
				if is_integer(ix_stg) then		-- here we get a bit position
	
					txt := full_name() + " index @" + str(abs(ix_stg)); 
					ix := tk_kall(txt);
					return unstr(ix) + 1;
	
				elseif ix_stg = "sel.last"  then	-- add 1 except for "sel.last" and "end"

					if tk_kall(full_name() + " select present") = "0" then return OM; end if;
					txt := full_name() + " index " + ix_stg; return unstr(tk_kall(txt));

				elseif ix_stg = "sel.first" then	-- add 1 except for "sel.last" and "end"
					
					if tk_kall(full_name() + " select present") = "0" then return OM; end if;
					txt := full_name() + " index " + ix_stg; return unstr(tk_kall(txt)) + 1;

				elseif ix_stg = "sel.anchor" then	-- add 1 except for "sel.last" and "end"
					
					if tk_kall(full_name() + " select present") = "0" then return OM; end if;
					txt := full_name() + " index anchor"; return unstr(tk_kall(txt)) + 1;
				
				elseif ix_stg = "end" then	-- add 1 except for "sel.last" and "end"
				
					txt := full_name() + " index " + ix_stg; return unstr(tk_kall(txt));
					
				else
				
					txt := full_name() + " index " + ix_stg; 
					return unstr(tk_kall(txt)) + 1;
				
				end if;
					
			when "text" => 			-- index position in a text widget
	
				if is_integer(ix_stg) then		-- here we get a bit position
	
					txt := full_name() + " index @" + str(abs(ix_stg)); 
					ix := tk_kall(txt);
					return adjust_text_ix(ix);
	
				elseif ix_stg = "sel.last"  then	-- add 1 except for "sel.last" and "end"

					if tk_kall(full_name() + " select present") = "0" then return OM; end if;
					txt := full_name() + " index " + ix_stg; return tk_kall(txt);

				elseif ix_stg = "sel.first" then	-- add 1 except for "sel.last" and "end"
					
					if tk_kall(full_name() + " select present") = "0" then return OM; end if;
					txt := full_name() + " index " + ix_stg; return tk_kall(txt) + 1;
				
				elseif ix_stg = "end" then	-- add 1 except for "sel.last" and "end"
			
					txt := full_name() + " index " + ix_stg; 
					
					return tk_kall(txt);

				else
				
					txt := full_name() + " index " + ix_stg; 
					return adjust_text_ix(tk_kall(txt));
				
				end if;
				
			otherwise => 

				txt := full_name() + " index \"" + ix_stg + "\""; return tk_kall(txt);

		end case;
		
	end index;

	procedure mark_set(name,n);		-- place a named mark at the specified index
		txt := full_name() + " mark set \"" + name + "\" \"" + str(n) + "\""; return tk_kall(txt);
	end mark_set;

	procedure mark_unset(name);		-- remove a named mark (can also be comma-separated list)
		txt := full_name() + " mark unset \"" + name + "\""; return tk_kall(txt);
	end mark_unset;

	procedure mark_gravity(name,n);	
		-- set the 'gravity' (left,right) of a mark, which determines the placement of strings inserted at the mark
		txt := full_name() + " mark gravity \"" + name + "\" " + str(n); return tk_kall(txt);
	end mark_gravity;

	procedure mark_next(n);		-- return the first mark after text position n
		txt := full_name() + " mark next \"" + str(n) + "\""; return tk_kall(txt);
	end mark_next;

	procedure mark_prev(n);		-- return the last mark before text position n
		txt := full_name() + " mark previous \"" + str(n) + "\""; return tk_kall(txt);
	end mark_prev;

	procedure search(options,pattern,n,m);			-- string search; returns empty string if unsuccessful
				-- search section of text frm m to n for a pattern. 'options' parameter can be
				-- "forward", "backward", "nocase", "count" (return count of matched characters)
				-- "exact", "regexp" (use regular expression matching)
				-- unless regular expression ,matching is specified, the 'pattern' is 
				-- only allowed to have "*" (wildcard), ? (one char), or [abc] specified chars
		txt := full_name() + " search " + handle_search_options(options) + " -- \"" + 
					stg_to_Tk(pattern) + "\" " + 
					if n = OM then "1.0" else str(n) end if + " " + 
					if m = OM then "" else " " + str(m) end if;
		return (the_start := adjust_text_ix(tk_kall(txt))) + 
				if "count" notin chop(options) then ""
				else "," + the_start + "+" + str(unstr(getvar("```")) - 1) + "char" end if;
	end search;

	procedure handle_search_options(options);		-- handle possible options for search
		if options = OM then return ""; end if;
		return "" +/ [if "count" = option then "-count ``` " 
							else "-" + option + " " end if: option in chop(options)];
	end handle_search_options;
	
	procedure see(n);			-- scroll to make a given line.character position n visible
		txt := full_name() + " see \"" + str(n) + "\""; return tk_kall(txt);
	end see;

	procedure tag_add(tag,index_range_stg);		-- add tag to a list of character ranges
		txt := full_name() + " tag add " + tag + " " + handle_index_range(index_range_stg); 
		return tk_kall(txt);
	end tag_add;

	procedure tag_add_no_offs(tag,range_start,range_end);
		txt := full_name() + " tag add " + tag + " " + range_start + " " + range_end; 
		return tk_kall(txt);
	end tag_add_no_offs;
	
	procedure tag_remove(tag,index_range_stg);	-- remove tag from list of text ranges
		txt := full_name() + " tag remove " + tag + " "  + handle_index_range(index_range_stg); 
		return tk_kall(txt);
	end tag_remove;

	procedure handle_index_range(index_range_stg);		-- handle list of index ranges for tag addition
		ch_ixrs := chop(index_range_stg);
		return "" +/ [if odd(j) then normalize_text_index(rg) else "{" + rg?"end" + "}" end if + " ": rg = ch_ixrs(j)];
	end handle_index_range;

	procedure chop(stg); 		-- chop at semis or commas if is string
		return if not is_string(stg) then stg else breakup(stg,if ";" in stg then ";" else "," end if) end if;
	end chop;

--	procedure tag_delete(tag_list);		-- delete information for list of tags	[txt("tags") := list;]
--		txt := full_name() + " tag delete " + handle_tag_list(tag_list); 
--		return tk_kall(txt);
--	end tag_delete;

	procedure handle_tag_list(tag_list);		-- handle list of index tags for tag addition
		tags := chop(tag_list);
		return "" +/ ["{" + tag + "} ": tag in tags];
	end handle_tag_list;

	procedure tag_names(n);		-- return ordered list of tags at specified char position. OM gives all
		
		txt := full_name() + " tag names " + normalize_text_index(n);
		return breakup(tk_kall(txt)," ");
	end tag_names;

	procedure normalize_text_index(n);		-- adjust a text index to 1-basing
	
		if n = OM then return ""; end if;
		if is_integer(n) then return "1." + str(n - 1); end if;
		first_digit := span(n,"0123456789"); dot := match(n,"."); second_digit := span(n,"0123456789");
		
		if not (#first_digit > 0 and #dot > 0 and #second_digit > 0) then return "{" + n + "}"; end if;
		
		return "{" + first_digit + dot + str(unstr(second_digit) - 1) + n + "}";
	
	end normalize_text_index;
	
	procedure adjust_text_ix(ix); 		-- adjust the character number to 1-basing

		if ix = OM or ix ="" then return ix;  end if;
		[first_digits,second_digits]  := breakup(ix,"."); 
		return first_digits + "." + str(unstr(second_digits) + 1);
	end adjust_text_ix;
	
--	procedure tag_lower(tag,below);	-- lower tag to specified position in priority list of tags, or to start 
--		txt := full_name() + " tag lower \"" + str(tag) + "\"" + 
--							if below = OM then "" else " \"" + below + "\"" end if; 
--		return tk_kall(txt);
--	end tag_lower;

--	procedure tag_raise(tag,above);	-- raise tag to specified position in priority list of tags, or to end
--		txt := full_name() + " tag raise \"" + str(tag) + "\"" + 
--							if below = OM then "" else " \"" + above + "\"" end if; 
--		return tk_kall(txt);
--	end tag_raise;

	procedure tag_nextrange(tag,n,m);	-- search for first subrange of specified range that carries specified tag
		txt := full_name() + " tag nextrange \"" + str(tag) + "\" "+ str(n) + " " + 
							if m = OM then "" else " " + str(m) end if; 
		[ix1,ix2] := breakup(tk_kall(txt)," ");
		return [adjust_text_ix(ix1),adjust_text_ix(ix2)];
	end tag_nextrange;

	procedure tag_prevrange(tag,n,m);	-- search for last subrange of specified range that carries specified tag
		txt := full_name() + " tag prevrange \"" + str(tag) + "\" "+ str(m) + " " + 
							if n = OM then "" else " " + str(n) end if; 
		[ix1,ix2] := breakup(tk_kall(txt)," ");
		return [adjust_text_ix(ix1),adjust_text_ix(ix2)];
	end tag_prevrange;

	procedure tag_ranges(tag);			-- get list of all ranges for specified tag

		if tag_prevrange(tag,"1.0","end") = [] then return []; end if;		-- tag does not occur

		ranges := []; first_now := "1.0";				-- will  collect

		while (nrange := tag_nextrange(tag,first_now,"end")) /= [] loop
			[nr1,nr2] := nrange; ranges with:= nr1; 
			cpos := rbreak(nr2,"."); ranges with:= (nr2 + str(unstr(cpos) - 1));
			first_now := nrange(2);
		end loop;

		return ranges;

	end tag_ranges;

	procedure insert_widget(n,wind); -- insert an widget window at a specified text position
		txt := full_name() + " window create " + n + " -window " + wind.full_name();
--print("insert_widget: ",txt);
		return tk_kall(txt);
	end insert_widget;

	procedure handle_options_and_values(options_values);		-- convert comma-delimited widget options into tk form
							-- options are align (), window (), stretch (), padx (), pady (), command ()
		return "" +/ [if odd(j) then "-" else "{" end if + 
					if is_string(ov) then ov else ov.full_name() end if		-- if the value is a widget, use its name
										+ if odd(j) then " " else "} " end if: ov = options_values(j)];
	end handle_options_and_values;

	-- ****** Button Operations ******

	procedure flash();			-- cause the button to flash
		txt := full_name() + " flash"; return tk_kall(txt);
	end flash;

	procedure invoke_button();	-- trigger the button's action
		txt := full_name() + " invoke"; 
		return tk_kall(txt);
	end invoke_button;

	procedure select_button();	-- select radio button or checkbutton
		txt := full_name() + " select"; return tk_kall(txt);
	end select_button;

	-- ****** Menu Operations ******

	procedure clone();					-- make linked copy of the menu (for tearoffs, etc.)
		txt := full_name() + " clone"; return tk_kall(txt);
	end clone;

	procedure invoke(n);				-- trigger the entry's action; note that invoke(0) does a tearoff
		txt := full_name() + " invoke " + str(n);
		return tk_kall(txt);
	end invoke;

	procedure post(i,j);				-- display menu at specified coordinates
		txt := full_name()  + " post " + str(i) + " " + str(j); 
		return tk_kall(txt);
	end post;

	procedure postcascade(n);			-- display menu in hierarchical position for entry n
		txt := full_name()  + " postcascade \"" + str(n) + "\""; return tk_kall(txt);
	end postcascade;

	procedure popup(i,j);				-- display menu at specified coordinates
		txt := "tk_popup " + full_name()  +  " " + str(i) + " " + str(j);  return tk_kall(txt);
	end popup;

	procedure entry_type(n);					-- get the type of menu entry n 
		txt := full_name() + " type \"" + str(n) + "\""; return tk_kall(txt);
	end entry_type;

	procedure unpost();					-- hide the menu
		txt := full_name() + " unpost"; return tk_kall(txt);
	end unpost;

	procedure yposition(n);				-- return vertical position of top of entry n
		txt := full_name() + " yposition \"" + str(n) + "\""; return tk_kall(txt);
	end yposition;
								
	-- ****** Scale Operations ******

	procedure coords(n);		-- transform scale value into geometric position
		txt := full_name() + " coords \"" + str(n) + "\""; 
		return [unstr(x): x in breakup(tk_kall(txt)," ")];		-- return a tuple
	end coords;

	procedure get(ij);			-- get scale value, or value corresponding to given position
		is_horizontal := tk_kall(full_name()  + " cget -orient") = "horizontal";
		txt := full_name()  + " get " + join(breakup(ij,",;")," "); 
		return unstr(tk_kall(txt));
	end get;

	procedure identify(ij);	-- return 'trough', 'slider', or 'trough2': feature under indicated point
		txt := full_name()  + " identify " +join(breakup(ij,",;")," ");
		return tk_kall(txt);
	end identify;

	-- ****** Scrollbar Operations ******

	procedure activate(x);		-- query/set active element, which can be arrow1, arrow2, or slider
		txt := full_name() + " activate " + x; return tk_kall(txt);
	end activate;

	procedure delta(dxy);		-- convert desired horizontal or vertical value change to slider units
		is_vertical := tk_kall(full_name()  + " cget -orient") = "vertical";
		piece := if is_vertical then "0 " + str(dxy) else str(dxy) + " 0" end if;
		txt := full_name() + " delta " + piece; 
		return tk_kall(txt);
	end delta;

	procedure fraction(x);	-- convert point position into fraction relative to scrollbar extent
		is_vertical := tk_kall(full_name()  + " cget -orient") = "vertical";
--print("is_vertical",is_vertical);
		piece := if is_vertical then "0 " + str(x) else str(x) + " 0" end if;
		txt := full_name()  + " fraction " + piece; 
		return tk_kall(txt);
	end fraction;

	-- ****** Entry Operations ******

	procedure bbox(n);		-- return bounding box of specified character in text or entry, or line in listbox
		
		txt := full_name() + " bbox " + if tk_type = "entry" then str(n + 1) else str(n) end if; 
--print("bbox(n): ",txt," ",tk_kall(txt));		-- some problem for listboxes
		 [l,t,w,h] := [unstr(x): x in breakup(tk_kall(txt)," ")];
		 return [l,t,w + l,h + t];
		
	end bbox;

	procedure select(m,n);		-- select characters m to n, or clear the selection (this also works for listboxes)

		if m = OM and n = OM then 
			txt := full_name() + " select clear"; return tk_kall(txt);
		end if;

		if tk_type = "listbox" then		--listbox range selection
			n := if is_integer(n) then (n - 1) else "\"" + n + "\"" end if;
			txt := full_name() + " select set \"" + (m - 1) + "\" " + n;
		else		-- character range  selection
			n := if n = OM then "" else "\"" + n + "\"" end if;
			txt := full_name() + " select range \"" + m + "\" " + n; 
		end if;
		
		return tk_kall(txt);
		
	end select;

	procedure select_anchor(m);		-- set the anchor point for the selection
		txt := full_name() + " select from \""+ str(m) + "\""; return tk_kall(txt);
	end select_anchor;

	-- 						****** Rastport Operations ******

	procedure put_img(gr_img,x,y);	-- stuff gr_img into tkrport at position x, y
		tk_gr_put(interp,full_name(),gr_img.native_im(),x,y);
	end put_img;

	procedure put_add(gr_img,x,y);	-- stuff gr_img into tkrport using 'sum'
		tk_gr_put_add(interp,full_name(),gr_img.native_im(),x,y);
	end put_add;

	procedure put_dif(gr_img,x,y);	-- stuff gr_img into tkrport using 'dif'
		tk_gr_put_dif(interp,full_name(),gr_img.native_im(),x,y);
	end put_dif;

	procedure put_mul(gr_img,x,y);	-- stuff gr_img into tkrport using 'mul'
		tk_gr_put_mul(interp,full_name(),gr_img.native_im(),x,y);
	end put_mul;

	procedure put_div(gr_img,x,y);	-- stuff gr_img into tkrport using 'div'
		tk_gr_put_div(interp,full_name(),gr_img.native_im(),x,y);
	end put_div;

	procedure put_min(gr_img,x,y);	-- stuff gr_img into tkrport using 'min'
		tk_gr_put_min(interp,full_name(),gr_img.native_im(),x,y);
	end put_min;

	procedure put_max(gr_img,x,y);	-- stuff gr_img into tkrport using 'max'
		tk_gr_put_max(interp,full_name(),gr_img.native_im(),x,y);
	end put_max;

	procedure put_pow(gr_img,x,y);	-- stuff gr_img into tkrport using 'pow'
		tk_gr_put_pow(interp,full_name(),gr_img.native_im(),x,y);
	end put_pow;

	procedure put_blend(gr_img,x,y,c1,c2);
				-- blend the image gr_img with the tk widget at position x, y using coefficients c1 and c2
		tk_gr_put_blend(interp,full_name(),gr_img.native_im(),x,y,c1,c2);
	end put_blend;

	procedure put_imgr(gr_img,x,y);	-- stuff gr_img into tkrport at position x, y
		tk_gr_put_and_rotate(interp,full_name(),gr_img.native_im(),x,y);
	end put_imgr;

	procedure put_addr(gr_img,x,y);	-- stuff gr_img into tkrport using 'sum'
		tk_gr_put_add_and_rotate(interp,full_name(),gr_img.native_im(),x,y);
	end put_addr;

	procedure put_difr(gr_img,x,y);	-- stuff gr_img into tkrport using 'dif'
		tk_gr_put_dif_and_rotate(interp,full_name(),gr_img.native_im(),x,y);
	end put_difr;

	procedure put_mulr(gr_img,x,y);	-- stuff gr_img into tkrport using 'mul'
		tk_gr_put_mul_and_rotate(interp,full_name(),gr_img.native_im(),x,y);
	end put_mulr;

	procedure put_divr(gr_img,x,y);	-- stuff gr_img into tkrport using 'div'
		tk_gr_put_div_and_rotate(interp,full_name(),gr_img.native_im(),x,y);
	end put_divr;

	procedure put_minr(gr_img,x,y);	-- stuff gr_img into tkrport using 'min'
		tk_gr_put_min_and_rotate(interp,full_name(),gr_img.native_im(),x,y);
	end put_minr;

	procedure put_maxr(gr_img,x,y);	-- stuff gr_img into tkrport using 'max'
		tk_gr_put_max_and_rotate(interp,full_name(),gr_img.native_im(),x,y);
	end put_maxr;

	procedure put_powr(gr_img,x,y);	-- stuff gr_img into tkrport using 'pow'
		tk_gr_put_pow_and_rotate(interp,full_name(),gr_img.native_im(),x,y);
	end put_powr;

	procedure put_blendr(gr_img,x,y,c1,c2);
				-- blend the image gr_img with the tk widget at position x, y using coefficients c1 and c2
		tk_gr_put_blend_and_rotate(interp,full_name(),gr_img.native_im(),x,y,c1,c2);
	end put_blendr;

	procedure get_img(gr_img,x,y);	-- stuff gr_img into tkrport at position x, y
		x := tk_gr_get(interp,full_name(),gr_img.native_im(),x,y);
	end get_img;

	procedure get_add(gr_img,x,y);	-- stuff gr_img into tkrport using 'sum'
		tk_gr_get_add(interp,full_name(),gr_img.native_im(),x,y);
	end get_add;

	procedure get_dif(gr_img,x,y);	-- stuff gr_img into tkrport using 'dif'
		tk_gr_get_dif(interp,full_name(),gr_img.native_im(),x,y);
	end get_dif;

	procedure get_mul(gr_img,x,y);	-- stuff gr_img into tkrport using 'mul'
		tk_gr_get_mul(interp,full_name(),gr_img.native_im(),x,y);
	end get_mul;

	procedure get_div(gr_img,x,y);	-- stuff gr_img into tkrport using 'div'
		tk_gr_get_div(interp,full_name(),gr_img.native_im(),x,y);
	end get_div;

	procedure get_min(gr_img,x,y);	-- stuff gr_img into tkrport using 'min'
		tk_gr_get_min(interp,full_name(),gr_img.native_im(),x,y);
	end get_min;

	procedure get_max(gr_img,x,y);	-- stuff gr_img into tkrport using 'max'
		tk_gr_get_max(interp,full_name(),gr_img.native_im(),x,y);
	end get_max;

	procedure get_blend(gr_img,x,y,c1,c2);
				-- blend the image gr_img with the tk widget at position x, y using coefficients c1 and c2
		tk_gr_get_blend(interp,full_name(),gr_img.native_im(),x,y,c1,c2);
	end get_blend;

	-- ****** Other Operations using standard SETL syntax******

	procedure #self;			-- various size-related operations
	
		case tk_type		-- this operation is implemented differently for different types of widgets
			
			when "listbox","entry","menu" =>	txt := full_name() + " index end";
					return unstr(tk_kall(txt)) + 1;

			when "text" =>	las := tk_kall(full_name() + " index end"); 
							rbreak(las,"."); rmatch(las,"."); 
							return if las = "2" and 
								#tk_kall(full_name() + " get 1.0 {1.0 lineend}") = 0 then 0 
									else unstr(las) - 1 end if;

			when "canvas_text" =>	las := tk_kall(txt := parent.full_name() + " index " + name(2..) + " end"); 
--print("canvas_text: ",txt);
							return unstr(las) + 1;

		end case;
	
	end;
	
	procedure self(i..j);			-- various extraction operations
		-- this operation is used to extract contiguous ranges in various situations. 
		-- text widgets: retrieves a range of characters; absolute images: retrieves a rectangle
		-- listboxes: retrieves a range of lines
	
		case tk_type		-- this operation is implemented differently for different types of widgets
			
			when "listbox" =>		-- return the range of list entries, as a blank-delimited string
									-- offset indices to be 1-based, as in SETL
												
				txt := full_name() + " get " + str(i - 1) + " " + str(j - 1);
				return stgs_from_Tk(tk_kall(txt));		-- break into list and return
				
			when "text" =>			-- return span of characters from text
				
				txt := full_name() + " get " + normalize_text_index(i) + " " + str(j);
			
			when "canvas_text" =>			-- return span of characters from canvas_text item
				
				txt := parent.full_name() + " itemcget " + name(2..) + " -text";
				stg := tk_kall(txt);
				return stg(i..j);

			when "entry" =>			-- return span of characters from entry
				
				if is_string(i) then i := unstr(i); end if;
				if is_string(j) then j := unstr(j); end if;
				
				cont := tk_kall(full_name() + " get");
				return if j = OM then cont(i..) else cont(i..j) end if;

			when "menu" =>					-- return the range of menu labels, as a tuple
				
				return [tk_kall(full_name() + " entrycget " + str(k) + " -label"): k in [i..j]];
			
			when "image" =>			-- return an image subrectangle
				
				if parent /= OM then		-- not an absolute image
					abort("Subimage extraction is only available for absolute images.");
				end if;

				
				i := chop(i); j := chop(j);

				if not is_tuple(i) or #i /= 2 then  
					abort("Illegal first argument " + str(i));
				end if;

				if not is_tuple(j) or #j /= 2 then  
					abort("Illegal second argument " + str(j));
				end if;
				
				[i1,i2] := i; [j1,j2] := j; i1 := str(i1); i2 := str(i2); j1 := str(j1); j2 := str(j2);

				new_im := tkw();							-- create a new image
				new_im.name := imnm := "`" + str(name_ctr +:= 1);	-- assign name (with no originating file)
				new_im.tk_type := "image";						-- tk_type is "image"
				
								-- now copy the designated subrectangle into the image
				txt := "image create photo " +  imnm;	tk_kall(txt);	-- create the Tk image
				
				txt := imnm + " copy " + name + " -from " + i1 + " " + i2 + " " + j1 + " " + j2;
								-- copy the designated subrectangle
				tk_kall(txt);
				return new_im;
		end case;
		
		return tk_kall(txt);

	end;
	
	procedure self(i..j) := y;			-- various insertion and deletion operations
		-- this operation is used to insert contiguous ranges of items in various situations: 
		-- text widgets: inserts a range of characters
		-- listboxes: insets a range of lines
		
		if is_string(y) and tk_type /= "text" and tk_type /= "canvas_text" and tk_type /= "entry" then
															 		-- convert to tuple
			y := chop(y);
		end if;
		
		case tk_type		-- this operation is implemented differently for different types of widgets
			
			when "listbox" =>				-- offset indices to be 1-based, as in SETL
				
				listbox_len := tk_kall(full_name() + " index end");

								-- get the length of the listbox
				j min:= unstr(listbox_len);		-- constrain the end of the deletion range

				if j >= i then			-- first delete the items in the range
					txt := full_name() + " delete " + str(i - 1) + " " + str(j - 1);
					tk_kall(txt);		-- execute the deletion operation
				end if;
								-- now insert the string of labels after position i 
				txt := full_name() + " insert " + str(i - 1) + 
							" " +/ ["\"" + str(item) + "\" ": item in y];
			
			when "text" =>			-- write span of characters to text
				
				j ?:= "end";		-- first delete the specified characters
				txt := full_name() + " delete " + (ip := normalize_text_index(i)) + " " + str(j);
				tk_kall(txt);		-- execute the deletion operation

						-- now insert the string y into their place. 
				txt := full_name() + " insert " + ip + " \"" + stg_to_Tk(str(y)) + "\"";
			
			when "canvas_text" =>			-- write span of characters to canvas_text item
				istg :=  str(i - 1); jstg := str(j - 1);
				if  j >= i then 							-- first delete the characters to be over_written
					txt :=  parent.full_name() + " dchars " + name(2..) + " " + istg + " " + jstg;
					tk_kall(txt);		-- execute the deletion operation
				end if;
				
						-- now insert the string y into their place. 
				txt := parent.full_name() + " insert " + name(2..) + " " + istg + " \"" + stg_to_Tk(str(y)) + "\"";

			when "entry" =>			-- return span of characters from entry 
				
				j ?:= "end";			-- first delete the specified characters

				txt := full_name() + " delete " + (ip := str(if is_string(i) then unstr(i) else i end if - 1)) + " " + str(j);

				tk_kall(txt);		-- execute the deletion operation

						-- now insert the string y into their place. 
				txt := full_name() + " insert " + ip + " \"" + stg_to_Tk(str(y)) + "\"";

			when "menu" =>					-- insert a range of menu labels
				
				menu_len := tk_kall(full_name() + " index end");

								-- get the length of the menu
				j min:= unstr(menu_len);		-- constrain the end of the deletion range
				menu_name := full_name();
				
				if j >= i then			-- first delete the items in the range
					txt := menu_name + " delete " + str(i) + " " + str(j);
					tk_kall(txt);		-- execute the deletion operation
				end if;

				insert_menu_items(i,menu_name,y); 				

 				return OM;			-- done with this case
 			
			when "image" =>			-- insert an image subrectangle
				
				if parent /= OM then		-- not an absolute image
					abort("Subimage insertion is only available for absolute images.");
				end if;

				
				i := chop(i); j := chop(j);

				if not is_tuple(i) or #i /= 2 then  
					abort("Illegal first argument " + str(i));
				end if;

				if not is_tuple(j) or #j /= 2 then  
					abort("Illegal second argument " + str(j));
				end if;
				
				[i1,i2] := i; [j1,j2] := j; i1 := str(i1); i2 := str(i2); j1 := str(j1); j2 := str(j2);
--print("insert an image subrectangle y: ",y);
				if type(y) /= "TKW" or y.tk_type /= "image" or y.parent /= OM then
					abort("Right-hand argument must be an absolute image"); 		-- the y argument
				end if;
				
								-- now copy the image into the designated subrectangle 
				txt := name + " copy " + y.name + " -to " + i1 + " " + i2 + " " + j1 + " " + j2;

		end case;
		
		tk_kall(txt);
	
	end;

	procedure insert_menu_items(pt,menu_name,desc_lis);
								-- construct and insert the items of a menu from a descriptor 
		pt -:= 1; spt := str(pt);
		items := breakup(desc_lis,":");
		
		for  j in [#items,#items - 1..1] loop
			
			[kind,lab] := items(j);
			
			if lab = OM then			-- should be separator or tearoff

				if kind = "t" then		-- tearoff
					tk_kall(menu_name + " insert " + spt + " tearoff");
				else					-- take as separator
					tk_kall(menu_name + " insert " + spt + " separator");
				end if;

			else
				
				case kind

					when "c" => 		-- checkbutton item
						tk_kall(menu_name + " insert " + spt + " check -label " + lab);
					when "r" =>  		-- radiobutton item
						tk_kall(menu_name + " insert " + spt + " radio -label " + 
																				lab + " -variable " + lab);
					when "s" =>   		-- submenu item
						tk_kall(menu_name + " insert " + spt + " cascade -label " + lab);
					otherwise =>  		-- take as button item
						tk_kall(menu_name + " insert " + spt + " command -label " + lab);
				end case;
				
			end if;

		end loop;
		
	end insert_menu_items;

	procedure self{event_des};		-- query binding to an event descriptor, for a widget, tag, or item
	 	
	 	item_name := OM;
	 	
	 	if is_tuple(event_des) then		-- we are retrieving a binding for a tag or menu item 
--print("is_tuple event_des: ",event_des," ",tk_type);
		 	[item_name,event_des] := event_des;		-- extract the item and the real event_des

	 		if item_name = "event" then 
	 			return breakup(suppress_chars(tk_kall("event info " + if event_des = OM then "" else "<<" + event_des + ">>" end if),"")," ");
	 						-- return info on specific, or on all, virtual events

	 		elseif item_name = "bindings" then		-- if this is not a canvas or text object, then return event binding list for binding tag
	 				-- otherwise return the event binding list for a canvas or text tag

				if tk_type = "text"  then  -- return the event binding list for a text tag

	 				res := breakup(tk_kall(full_name() + " tag bind " + event_des)," ");		-- here event_des is actually the tag
					new_bindings := []; 
					for x in  res loop match(x,"<"); rmatch(x,">"); new_bindings with:= x; end loop; -- drop one set of angle brackets
					return new_bindings;

				elseif tk_type = "canvas" then
					  -- return the event binding list for a tag on some canvas item or for a text tag

	 				res := breakup(tk_kall(full_name() + " bind " + event_des)," ");		-- here event_des is actually the tag
					new_bindings := []; 
					for x in  res loop match(x,"<"); rmatch(x,">"); new_bindings with:= x; end loop; -- drop one set of angle brackets
					return new_bindings;
	
				else

	 				res := breakup(tk_kall("bind " + event_des)," ");		-- here event_des is actually the tag
--print("event binding list: ","bind " + event_des," ",res);
					new_bindings := []; 
					for x in  res loop match(x,"<"); rmatch(x,">"); new_bindings with:= x; end loop; -- drop one set of angle brackets
	
					return new_bindings;
				end if;
			elseif tk_type = "canvas" then

				return tk_kall(full_name() + " bind " + item_name + " <" + event_des + ">");

			elseif tk_type = "text" then
--print("text binding tag and event: ",full_name() + " bind " + item_name + " <" + event_des + ">");
				return tk_kall(full_name() + " tag bind " + item_name + " <" + event_des + ">");
			
			else			-- return the Tk binding information for a specific binding tag and event. 
							-- This covers  cases like Tk("Text","") 
				return tk_kall("bind " + item_name + " <" + event_des + ">");
	 		end if;
--->event
		elseif event_des = OM then 	-- retrieve the handler for the 'principal' event associated with the widget or item
			
			if (event_des := main_command(tk_type)) = OM then		-- use the 'cget' option
				return tk_kall(full_name() + " cget -command");
			end if;
			
		elseif event_des = "bindtags" then 	-- retrieve the list  of binding tags for the widget

			return breakup(tk_kall("bindtags " + full_name())," ");		-- convert to SETL list

	 	end if;		-- else we are retrieving a binding for a widget, canvas item, or text item (using its id)
	  	
	  	if ":" in event_des then 
	  		rbreak(event_des,":"); rmatch(event_des,":");		-- remove the parameter descriptor
	  	end if;
	  	
	  	event_des := chop(event_des);
	  	event_stg := "" +/["<" + item + ">": item in event_des];		-- convert event_stg to Tk format

	  	if item_name = OM then			-- we are querying a binding for a widget, 
	  									-- or for a canvas item or text item (using its id)
			
			if name = "" then return OM; end if;		-- 'name' is the object name property
			 
			if name(1) = "w" then		-- querying binding for a widget
	  			txt := "bind " + full_name() + " " + event_stg;
					-- construct a Tk 'bind' instruction, which lists event fields to be passed back
			else				-- querying binding for a canvas item, or text item (using its id)
		  		txt := parent.full_name() + " " + "bind " + name(2..) + " " +  event_stg;
			end if;
			
	  	else					-- we are querying a binding for a text tag, canvas tag, tag or menu item
	  		txt := "???"; 
	  	end if;

	  	return tk_kall(txt);			-- return the binding info
	
	end;

	procedure self{event_des} := y;		-- set binding to an event descriptor, for a widget, tag, or menu item
		
		if tk_type = "socket" then return bind_socket_io_handler(event_des,y); end if;		-- here event_des is ">" or "<"

		y_orig := y;						-- save the original y
		y := chop(y);						-- break into tuple if punctuated string
		if y = [] then y := ""; end if;		-- restore nullstring case to original form
--print("y is: ",y,"..",y_orig,"..");		

		if is_tuple(event_des) and event_des(1) = "event" then			-- we are setting  up the list of physical events that correspond to a virtual event 
										-- this covers cases like  Tk("event","virt_event_name") := "phys_event_1,phys_event_2,..."
			virt_event_name := "<<" + event_des(2) + ">>";		-- get the  virtual event name
			delres := tk_kall("event delete " + virt_event_name);		-- clear the present meaning
			if (y?"") = "" then return delres; end if;		-- null assignment is simple deletion
			return tk_kall("event add " + virt_event_name + " " +/["<" + phys + "> ": phys in y]);		-- set up the new meaning
		end if;
		
		if not (is_tuple(y) or is_procedure(y) or y = "") then
			abort("Only procedures or the null-string can be bound to events, not " + str(y));
	 	end if;

	 	if (isp := is_procedure(y)) or y = "" then y := tk_string_of(y); end if;		-- convert the procedure to its string name; likewise  nullstring
	 									-- (this is a tuple if we are sending an event)

		if event_des = "bindtags" then		-- we  are setting a widget's 'bindtags' list
			
			 return tk_kall("bindtags " + full_name() + " [list " + join(y," ") + "]");

	  	elseif not isp then	 	-- we are sending an event under program control,  or setting the binding of  a binding tag
							-- this covers cases like  Tk("event_des:xy") := "event_par_val_1,event_par_val_2,..."
							-- it also covers cases like Tk("Text","") := Tk_code_string
							-- if there is just one  parameter  value, it must be  like Tk("event_des:x") := [event_par_val_1]

		 	if is_tuple(event_des) then 			-- here we handle cases like Tk("Text","") := Tk_code_string
				[binding_tag,event_des] := event_des;		-- break out the binding tag
				txt := "bind  " + str(binding_tag) + " <" + event_des + "> {" + y_orig + "}";	-- convert to form like 'bind Text <> {Tk_code_string}'
				return tk_kall(txt);		-- done with this case
			end if;
			
	 		event := break(event_des,":"); match(event_des,":");	-- break out the event descriptor
	 		
	 		
	 		ev_att_stg := "" +/ ["-" + eo + " " + str(eov) + " ": c = event_des(j) | 
	 							(eo := event_opts_from_chars(c)) /= OM and (eov := y(j)) /= OM];
	 		
	 		txt := "event generate " + full_name() + " <" + event + "> " + ev_att_stg;

			return tk_kall(txt);
			
	 	end if;		
	 					-- in the remaining cases, y was originally a procedure; but it  has now been converted to its Tk procedure name
	 	if event_des = OM then			-- bind the 'principal' event

				-- the various kinds of buttons (other than menu buttons) have built-in principal
				-- commands; for the others we use the principal commands designated above (main_command)
				-- note that for scales and scrollbars, the built-in principal command is invoked
				-- when the scale-value changes

				-- we assign a value to the widget or item by binding its specified 
				-- main_command event to it. The tk binding syntax varies a bit, depending
				-- on whether this object is a widget or a canvas object.
			if (mc := main_command(tk_type)) = OM then		-- use 'config'  
				the_text := full_name() + " configure -command " + "{" + y + "}";
			elseif tk_type in widgets then				-- we deal with a widget
				if mc /= "" then
					the_text := " bind " + full_name() + " " + mc + " {" + y + "}";
				else
					the_text := " bind " + full_name() + " " + mc + " {" + y + " %x %y}";
				end if;
			else									-- we deal with a canvas object
				the_text := parent.full_name() + " bind " + name(2..) + " " + mc + " {" + y + "}";
			end if;

			return tk_kall(the_text);

	 	end if;
	 	
	 	item_name := OM;
	 	
	 	if is_tuple(event_des) then		-- we are setting up a binding for a tag or menu item,
	 									-- or defining and sending an event under program control
	 	
		 	[item_name,event_des] := event_des;		-- extract the item and the real event_des

		 	if event_des = OM then		-- this is of the form tag_name, OM, so we are setting the
		 								-- main command of a canvas or text tag

				if type(y_orig) /= "PROCEDURE" then
					abort("A tag's principal command can only be bound to a procedure but is: " + str(y_orig));
				end if;

				if tk_type = "menu" then 		-- must use configuration option

					item_name := if is_integer(item_name) then item_name - 1 else unstr(item_name) end if; 

					txt := full_name() + " entryconfigure  " + str(item_name)  + " -command " + y;
--print("bound: ",txt);
				else		-- not a menu
					btb := if tk_type = "canvas" then " bind " 
								else " tag bind " end if;   -- Bah!
					txt := full_name() + btb + str(item_name) + "  " + y;
				end if;
				
 				return tk_kall(txt);
						
		 	end if; 
		 	
	 	end if;		-- else we are setting up a binding for a widget, canvas item, or text item (using its id),

	  	if ":" in event_des then 
	  		param_stg := rbreak(event_des,":"); rmatch(event_des,":");		-- break out the parameter descriptor
	  	else
	  		param_stg := "";		-- otherwise no parameters
	  	end if;
	  	
	  	param_stg := "" +/["%" + c + " ": c in param_stg];		-- convert param_stg to Tk format
	  	
	  	event_des := chop(event_des);
	  	event_stg := "" +/["<" + item + ">": item in event_des];		-- convert event_stg to Tk format

	  	if item_name = OM then	-- we are setting up a binding for a widget, canvas item, or text item (using its id)

			if name = "" then return; end if;		-- this should not happen
			 
			if name(1) = "w" or name = "." then		-- binding for a widget
	  			txt := "bind " + self.full_name() + " " + event_stg + " {" + y + " " + param_stg + "}";
					-- construct a Tk 'bind' instruction, which lists event fields to be passed back

			else				-- binding for a widget, canvas item, or text item (using its id)
		  		txt := parent.full_name() + " " + "bind " + name(2..) + " " +  event_stg 
		  														+ " {" + y + " " + param_stg + "}";
			end if;
--print("bindinginst: ",event_des," ",y," ",txt);			
		
		elseif tk_type = "text" or tk_type = "canvas" then
				 										-- we are setting up a binding for a text or canvas tag
			txt := full_name() + if tk_type = "text" then " tag bind " else " bind " end if + item_name  + " " +  event_stg
	  				+ " {" + y + if param_stg = "" then "" else " " end if + param_stg + "}";
--print("Binding text or canvas tag: ",item_name," ",event_des," ",txt);		 	
	  	else
	  		txt := "???";					-- we are setting up a binding for a tag or menu item 
	  	end if;

	  	res := tk_kall(txt);				-- do the binding
--print("Bound: ",txt," ",res);
	end;

	procedure bind_socket_io_handler(x,io_event_proc);		-- binds I/O-ready callback handler to socket
			-- x is ">" for 'socket_readability_handler' and "<" for 'socket_writability_handler'
--print("bind_socket_io_handler: ",x," ",y);	
		if not is_string(x) or #x > 1 or x notin "" then print("****** bad socket direction indicator: ",x); stop;  end if;		-- validate x
		
		if not is_procedure(io_event_proc) then			-- bad I/O handler
			print("****** bad io_event_proc for socket ",if x = ">" then "reading:" else  "writing: " end if,text_blocksize_or_accept_proc); stop;
		end if;
		
		proc_name := "s" + str(namegen_ctr := (namegen_ctr?0) + 1);			-- generate a new tk variable name
		tk_createcommand(interp,proc_name,io_event_proc);					-- register the setl procedure under this name
		
		if x = ">" then			-- set up the procedure as a 'ready to read' handler
			tk_kall("fileevent " + name + " readable [list " + proc_name + " " + name + "]");	-- pass 'set  handler' command to tk
		else					-- set up the procedure as a 'ready to write' handler
			tk_kall("fileevent " + name + " writeable [list " + proc_name + " " + name + "]");	-- pass 'set  handler' command to tk
		end if;

	end bind_socket_io_handler;

	procedure stg_to_Tk(stg);		-- sanitize the quote marks, blanks, backslashes, and square brackets in a string
--print("stg_to_Tk: ",stg);		
		newstr := break(stg,"\"[]\\ \n\r\t"); 				-- get the first non-special piece
		
		while stg /= "" loop 
			piece := any(stg,"\"[]\\ \n\r\t"); 
			newstr +:= if piece = "\n" then "\\n" elseif piece = "\r" then "\\r" 
				elseif piece = "\t" then "\\t" else "\\" + piece  end if;
							 	-- sanitize or recode the special character
			piece := break(stg,"\"[]\\ \n\r\t"); 
			newstr +:= piece; 				-- get the next non-special piece
		end loop;
	
--print("stg_to_Tk return: ",newstr);		
		return newstr;
		
	end stg_to_Tk;

	-- ****** Listbox Operations ******
	
	procedure nearest(y);		-- return index of line vertically nearest to y
		txt := full_name() + " nearest " + str(y); return tk_kall(txt);
	end nearest;

	procedure is_select_line(m);	-- determine if line m is selected
		txt := full_name() + " selection includes \"" + (m - 1) + "\""; return tk_kall(txt);
	end is_select_line;

	procedure yview(n);			-- move to make indicated line visible, or read vertical scroll position
		txt := full_name() + " yview " + if n = OM or n = "" then "" else (n - 1) end if; return tk_kall(txt);
	end yview;

	-- ****** Clipboard Operations ******

	procedure clear_selection(win,the_sel);			-- clear specified selection in specified window
		txt := "selection clear "; 
		if win /= OM then txt +:= (" -displayof " + win.full_name()); end if; 
		if the_sel /= OM then txt +:= (" -selection " + the_sel); end if; 
		return tk_kall(txt);
	end clear_selection;

	procedure get_selection(win,the_sel,the_type);	-- return the specified selection

		txt := "selection get "; 
		if win /= OM then txt +:= (" -displayof " + win.full_name()); end if; 
		if the_sel /= OM then txt +:= (" -selection " + the_sel); end if; 
		if the_type /= OM then txt +:= (" -type " + the_type); end if; 

		return tk_kall(txt);
	end get_selection;

	procedure handle_selection(win,the_type,format,the_sel,proc);
		-- define proc to be handler for set/the_type selection requests when 'win' is selection owner

		txt := "selection handle "; 
		if the_sel /= OM then txt +:= (" -selection " + the_sel); end if; 
		if the_type /= OM then txt +:= (" -type " + the_type); end if; 
		if format /= OM then txt +:= (" -format \"" + format + "\""); end if; 

		txt +:= " win"; 			-- ********* FIX ********* handle procedure

		return tk_kall(txt);
	end handle_selection;

	procedure own_selection(win,the_sel,proc);
		-- assert that win is sel owner; and that proc should be called when it loses ownership
		txt := "selection own "; tk_kall(txt);
		if win /= OM then txt +:= (" -displayof " + win.full_name()); end if; 
		if the_sel /= OM then txt +:= (" -selection " + the_sel); end if; 
		if proc /= OM then txt +:= " -command "; end if;  -- ********* FIX ********* handle procedure
	end own_selection;

	procedure selection_owner(win,the_sel);			-- find string name of current owner of selection 'sel'
		txt := "selection own "; tk_kall(txt);
		if win /= OM then txt +:= (" -displayof " + win.full_name()); end if; 
		if the_sel /= OM then txt +:= (" -selection " + the_sel); end if; 
	end selection_owner;

	procedure clear_clipboard(win);							-- clear clipboard for specified window
		txt := "clipboard clear " + if win = OM then "" else "-displayof " + win.full_name() end if; 
		return tk_kall(txt);
	end clear_clipboard;

	procedure addto_clipboard(win,the_type,format,data);	
			-- add 'data', of specified format and type, to clipboard for specified window

		txt := "clipboard append ";

		if win /= OM then txt +:= (" -displayof " + win.full_name()); end if; 
		if format /= OM then txt +:= (" -format \"" + format + "\""); end if; 
		if the_type /= OM then txt +:= (" -type " + the_type); end if; 
		txt +:= (" \"" + stg_to_Tk(data) + "\"");
--print("addto_clipboard: ",txt);
		return tk_kall(txt);

	end addto_clipboard;

	-- ****** Dialogs and Message boxes ******
		-- Note: all these have been put in the syntax win("ask_...","options") := "option_vals";

	-- ****** Image Operations ******

	procedure dither();			-- dither the image
		txt := name  + " redither"; 
--print("redither:",txt);
		return tk_kall(txt);
	end dither;

	procedure handle_im_options(options);	-- handle image read, write, and copy operations
		-- image operation options are from (rectangle), to (rectangle), subsample (x_fact,y_fact), 
		-- shrink (source to match bottom right corner of target), zoom (x_fact,y_fact)
		
		if options = "" or options = OM then return ""; end if;

		options := chop(options);		-- divide the options into a tuple, at commas  or semicolons
		
		tk_option_stg := "";		-- will build
		k := 1;
		
		for item = options(j) loop		-- iterate over list of options

			if odd(k) then 
				tk_option_stg +:= " -" + (prior := item) + " "; 
				k +:= if item = "shrink" then 2 else 1 end if;	-- no parameters in shrink case, so bypass
				continue; 			-- done with this case
			end if;		-- otherwise we have an option
			
			if prior = "format" then tk_option_stg +:= ("\"" + item + "\" "); k +:= 1; continue; end if;
								
			pieces := breakup(item,",");		-- otherwise break up the comma-delimited rectangles, etc.
			
			tk_option_stg +:= ("" +/ [piece + " ": piece in pieces]);
			k +:= 1;
			
		end loop;
		
		return "" +/ [c +" ": c in  breakup(tk_option_stg," ") | c /= ""];		-- return the completed tk option string, eliminating double blanks
		
	end handle_im_options;
			
	procedure write_im(file,options);	-- write image to file
		txt := name  + " write " + file + " " + handle_im_options(options);
--print("write_im: ",txt);
		res := tk_kall(txt); print(res); return res;
	end write_im;
	
	procedure tup_to_tx_imdat(tup);		-- convert tuple of image data to tx list
		return "{" + join(tup," ") + "}";
	end tup_to_tx_imdat;

	procedure stuff_im(data,rect);	-- insert data into image rectangle
		txt := name  + " put ";
		if is_string(data) then data := breakup(breakup(data,";"),","); end if;
						-- the 'data' argument is assumed to be a tuple of tuples of color values
		data := "{" + join([tup_to_tx_imdat(item): item in data]," ") + "}";
		txt +:= (data + " ");		-- add the data to the developing string
		
		if rect /= OM then 		-- add the optional 'to' clause
			txt +:= (" -to " +/ [str(item) + " ": item in chop(rect)]);
		end if; 

		return tk_kall(txt);

	end stuff_im;

	procedure copy_im(source,options);	-- copy one image to another
		txt := name  + " copy " + source.name + " " + handle_im_options(options); 
		return tk_kall(txt);
	end copy_im;

	-- 				****** Window Manager Operations ******

	procedure win_close();					-- close or iconify a toplevel
		return tk_kall("wm iconify " + full_name());		
	end win_close;

	procedure win_open();					-- open or deiconify a toplevel	
		test_exists := tk_kall("winfo toplevel " + full_name());	isb := match(test_exists,"bad");
		if isb /= "" then return OM; end if;
		return tk_kall("wm deiconify " + full_name());
	end win_open;

	-- ****** Font Routines ******
	procedure font_metrics(font);			-- get the metrics of the designated font
									-- as a map from "fixed","linespace",,"ascent","descent" to ints
		tup := breakup(suppress_chars(tk_kall("font metrics " + font),"-")," ");
		return {[tup(j),unstr(tup(j + 1))]: j in [1,3..7]};
	end font_metrics;

	procedure measure_fonted(stg,font);		-- get the size of the string in the designated font
		return tk_kall("font measure " + font + " \"" + stg + "\"");
	end measure_fonted;

	procedure font_families();				-- get the list of fonts available in Tk
		return tk_kall("font families");
	end font_families;


	-- ****** disk Routines ******
	procedure disks();			-- get the currently mounted disks
		return tk_kall("file volume");
	end disks;

	-- ****** Socket Routines ******
	procedure socket_close();			-- close a socket
		return tk_kall("close " + name);		-- pass this command to tk
	end socket_close;

-- 				********** Routines for persistency **************	

	procedure get_Tk_packed();		-- gets the Tk packing information as a map

		Tk_packed := {};			-- initialize

		all_containers := {x: x in domain(Tk_children) | (xk := tag_from_tagged_name(x)) = "toplevel" or xk = "frame"} 
							+ {x: range_tup in range(Tk_children), x in range_tup 
				| 				(xk := tag_from_tagged_name(x)) = "toplevel" or xk = "frame"};
		
		for obj_name in all_containers loop 
			tkog_names_list := breakup(Tk_kall("pack slaves " + fn_from_tagged_name(obj_name))," ");
			packed_list := [(att_map_from_att_stg(Tk_kall("pack info " + obj))	
								 - Tk_grid_defaults) less ["in",parent_name(obj)]
				 						with ["Tk_fn",tag_from_untagged_name(obj) + ":" + obj]: obj in tkog_names_list];
			Tk_packed(obj_name) := packed_list;
--print("\nTk_packed: "); for [x1,x2] in Tk_packed | #x2 > 0 loop print("\n",x1); for y in x2 loop print(y); end loop; end loop;
		end loop;

--print("\nTk_packed: "); for [x1,x2] in Tk_packed | #x2 > 0 loop print("\n",x1); for y in x2 loop print(y); end loop; end loop;
	end get_Tk_packed;

	procedure get_Tk_gridded();		-- gets the Tk gridding information as a map

		Tk_gridded := {};			-- initialize

		all_containers := {x: x in domain(Tk_children) | (xk := tag_from_tagged_name(x)) = "toplevel" or xk = "frame"} 
							+ {x: range_tup in range(Tk_children), x in range_tup 
				| 				(xk := tag_from_tagged_name(x)) = "toplevel" or xk = "frame"};
		
		for obj_name in all_containers loop 
			tkog_names_list := breakup(Tk_kall("grid slaves " + fn_from_tagged_name(obj_name))," ");
			gridded_list := [(att_map_from_att_stg(Tk_kall("grid info " + obj))	
								 - Tk_grid_defaults) less ["in",parent_name(obj)]
				 						with ["Tk_fn",tag_from_untagged_name(obj) + ":" + obj]: obj in tkog_names_list];
			if gridded_list /= [] then Tk_gridded(fn_from_tagged_name(obj_name)) := gridded_list; end if;
--print("gridded_list: ",obj_name," ",gridded_list," ",tkog_names_list);
		end loop;

--print("\nTk_gridded: "); for [x1,x2] in Tk_gridded  | #x2 > 0 loop print("\n",x1); for y in x2 loop print(y); end loop; end loop;
	end get_Tk_gridded;

	procedure get_Tk_children();		-- gets the full hierarchy of Tk children as a map

		Tk_children := {};			-- initialize
		get_Tk_children_in("toplevel:.");		-- call recursive workhorse
--print("\nTk_children",Tk_children);

	end get_Tk_children;

	procedure get_Tk_children_in(obj);		-- gets hierarchy of Tk children; workhorse 

		if (otkk := tag_from_tagged_name(obj)) notin {"toplevel","frame","menubutton","menu"} then return; end if;
		Tk_children(obj) := children := [tag_from_untagged_name(child) + ":" + child: 
					child in breakup(Tk_kall("winfo children " + fn_from_tagged_name(obj))," ")];

		for child in children loop get_Tk_children_in(child); end loop;
		
	end get_Tk_children_in;

			-- ******* Auxiliary reconfiguration routines for text; handle text dump string analysis *******

	procedure setup_from_dump(target_texwidg_name,dump_stg);		-- reconstruct a text area grom its dump string

		[text_tuple,tags_tuple,marks_tuple,widgets_tuple,images_tuple] 
			:= sep_tags_and_marks(stgs_from_Tk(dump_stg));
--print("text_tuple: ",text_tuple);
		the_text := "" +/text_tuple;		-- calculate  the new text; delete the old and insert the new
		Tk_kall(target_texwidg_name + " delete 1.0 end"); Tk_kall(target_texwidg_name + " insert 1.0 " + stg_to_Tk(the_text));

		for [win_name,cloc] in widgets_tuple loop 
			res := Tk_kall(txt := target_texwidg_name + " window create " + cloc + " -window " + fn_from_tagged_name(str(new_item_from_orig_name(win_name))));
--print("widgets_tuple: ",txt," ",win_name," ",new_item_from_orig_name(win_name));
		end loop;
		
		for [img_name,cloc] in images_tuple loop 
			Tk_kall(target_texwidg_name + " image create " + cloc +  " -image " + img_name);
		end loop;

		tags_to_ranges := {};
		
		for [mark,ix] in marks_tuple | mark /= "insert" and mark /= "current" loop
			Tk_kall(target_texwidg_name + " mark set {" + mark +  "} " + ix);
		end loop;
		 
		for [tag,loc] in tags_tuple loop
			tags_to_ranges(tag) := (tags_to_ranges(tag)?[]) with loc;
		end loop;

		for [tag,loc_list] in tags_to_ranges | tag /= "sel" loop
			Tk_kall(target_texwidg_name + " tag add {" + tag +  "} " + join(loc_list," "));
		end loop;

	end setup_from_dump;
		
	procedure sep_tags_and_marks(stg_tup);		-- separate a string's dump tuple into its text, plus tags_and_marks
	
		text_tuple  := [];
		tags_tuple  := [];
		marks_tuple  := [];
		widgets_tuple  := [];
		images_tuple  := [];
		
		j := 0;
		
		while j < #stg_tup loop
			piece := stg_tup(j +:= 1);

			case piece
				when "text" => text_tuple with:= stg_tup(j +:= 1); j +:= 1;
				when "tagon" => tags_tuple with:= [stg_tup(j +:= 1),stg_tup(j +:= 1)];
				when "tagoff" => tags_tuple with:= [stg_tup(j +:= 1),stg_tup(j +:= 1)];
				when "mark" => marks_tuple with:= [stg_tup(j +:= 1),stg_tup(j +:= 1)];
				when "window" => widgets_tuple with:= [stg_tup(j +:= 1),stg_tup(j +:= 1)];
				when "image" => images_tuple with:= [stg_tup(j +:= 1),stg_tup(j +:= 1)]; 
			end case;
			
		end loop;
		
		return [text_tuple,tags_tuple,marks_tuple,widgets_tuple,images_tuple];
		
	end sep_tags_and_marks;

		-- ************************ Minor persisency utiliies ************************

	procedure tag_from_tagged_name(tagged_name); tag := break(tagged_name,":"); return tag; end tag_from_tagged_name;
	procedure tag_from_untagged_name(untagged_name); tag := case_change(Tk_kall("winfo class " + untagged_name),"ul"); return tag; end tag_from_untagged_name;
	procedure fn_from_tagged_name(tagged_name); name := rbreak(tagged_name,":"); return name; end fn_from_tagged_name;

	procedure att_map_from_att_stg(att_stg);		--  convert raw Tk attribute information to SETL map form
		val_list := breakup(att_stg," ");
		return {[val_list(j)(2..),vljp1]: j  in [1,3..#val_list - 1] | (vljp1 := val_list(j + 1)) /= "{}"};
	end att_map_from_att_stg;
	
	procedure parent_name(name); 		-- gets name of parent from name of child
		rbreak(name,"."); 
		if #name > 1 then rmatch(name,"."); end if;
		return name;
	end parent_name;

end tkw;		-- ************************ END OF PACKAGE ************************

package drag_pak;		-- Drag setup package; also sets up for response to drop-on event.
		-- This package provides an easy-use drag or drag-and-drop capability for widgets.
		-- Calling the routine make_draggable(the_obj,dg_start,dg,dg_end) makes the widget 'the_obj'
		-- draggable. The 3 additional parameters dg_start, dg, and dg_end can be OM, but 
		-- if not they should all be procedures of one parameter, prepared to receive an integer
		-- point [x,y], the location of a mouse-related event. Then dg_start will be called 
		-- at the beginning of the drag, immediately after mousedown (whose location will be
		-- transmitted to it.) Similarly dg will be called for each mouse_move event, and 
		-- dg_end will be called on drag-end.

		-- If make_drop_sensitive(the_obj,drop_response) is called, its drop_response parameter
		-- should be a procedure drop_response(on_obj,dropped_obj) of two parameters, 
		-- which will be widgets. 'drop_response' will be called whenever the drag of an object
		-- 'dropped_obj', made draggable by 'make_draggable', ends with the mouse positioned over
		-- an object 'on_obj' made drop sensitive. 'drop_response' should then take whatever action
		-- is appropriate for a drop of dropped_obj onto on_obj.

		-- The test prgram given below shows how these procedures can be used to create a
		-- drag-and-drop oriented variant of the usual pocket calculator.

	var was_dragging,dropped_at;		-- the last object being dragged, and its drop point
	var start_canv_x,start_canv_y;		-- drag starting point, canvas relative, floating
	var start_coords_obj;				-- vector of starting coordinates
	var ops_in_drag_mode := {};				-- maps objects to their associated actions in specified mode
	var current_drag_mode :=  "edit";		-- current mode
		
	procedure make_draggable(the_obj,dg_start,dg,dg_end);		-- make a widget draggable
	procedure make_horiz_draggable(the_obj,dg_start,dg,dg_end);	-- make a widget or widgets horizontallly draggable
	procedure make_vert_draggable(the_obj,dg_start,dg,dg_end);	-- make a widget or widgets verticallly draggable
	procedure make_drop_sensitive(the_obj,drop_response);	
										-- build response for mouse entry event (by drop)
	procedure switch_drag_mode(new_mode);		-- switch the draggability mode

end drag_pak;

package body drag_pak;		-- drag setup package
use tkw;		-- use the basic widget package

	var drag_offs_x,drag_offs_y;		-- offset for object being dragged

procedure switch_drag_mode(new_mode);		-- switch the draggability mode
	if new_mode = current_drag_mode then return; end if;
	prior_domain := domain(prior_ops := ops_in_drag_mode(current_drag_mode)?{});		-- get the object-associated operations in the 
	new_domain := domain(new_ops := ops_in_drag_mode(new_mode)?{});					-- current  and target modes
	current_drag_mode := new_mode;													--  switch to the new mode
--print("switch_drag_mode: ",new_mode,new_domain,new_ops);	
	for obj in new_domain loop		-- change to the 'new  mode' operations  for all objects that have one
		[dg_start,dg,dg_end] :=  new_ops(obj);			-- get the start, drag, and end codes
		obj{"ButtonPress-1:xy"} := if dg_start = OM then attach_start_noproc([obj]) else attach_start([obj],dg_start) end if;
				-- only one object is put in the drag list
		obj{"B1-Motion:xy"} := if dg = OM then attach_drag_noproc([obj],0) else attach_drag([obj],dg,0) end if;
						-- we put this in 2D drag mode
		obj{"ButtonRelease-1:xy"} := if dg_end = OM then attach_end_noproc([obj]) else attach_end([obj],dg_end) end if;
	end loop;
	
					-- now turn  off any remaining operations that were on in the previous mode
	for obj in prior_domain - new_domain loop		-- change to the 'new  mode' operations  for all objects that have one
		obj{"ButtonPress-1"} := "";
		obj{"B1-Motion"} := "";
		obj{"ButtonRelease-1"} := "";
	end loop;

end switch_drag_mode;

procedure make_draggable(the_obj,dg_start,dg,dg_end);		-- make a widget or widgets draggable
	return gen_draggable(the_obj,dg_start,dg,dg_end,0);
end make_draggable;

procedure make_horiz_draggable(the_obj,dg_start,dg,dg_end);	-- make a widget or widgets horizontallly draggable
	return gen_draggable(the_obj,dg_start,dg,dg_end,1);
end make_horiz_draggable;

procedure make_vert_draggable(the_obj,dg_start,dg,dg_end);	-- make a widget or widgets verticallly draggable
	return gen_draggable(the_obj,dg_start,dg,dg_end,2);
end make_vert_draggable;

procedure gen_draggable(the_obj,dg_start,dg,dg_end,horiz_vert);		-- make a widget or widgets draggable
	if not is_tuple(the_obj) then the_obj := [the_obj]; end if;		-- force to tuple; note that a list of widgets sharing common drag routines might have been passed
	
	if (nam := (the_obj(1)).Tk_id()) = "" then 
		return; 		-- this should not happen
	end if;

	if nam(1) = "w" then 			-- dealing with a widget
		w_make_draggable(the_obj,dg_start,dg,dg_end,horiz_vert);
	else 							-- dealing with a canvas item
		c_make_draggable(the_obj,dg_start,dg,dg_end,horiz_vert);
	end if;

end gen_draggable;

procedure w_make_draggable(the_objs,dg_start,dg,dg_end,horiz_vert);		-- make a lst of widgets sharing common drag routines draggable
	
	for the_obj in the_objs loop

		if is_procedure(dg_start) then 		-- attach the start routine with extra action
			the_obj{"ButtonPress-1:XY"} := press_op := attach_start(the_objs,dg_start);
		else								-- attach the start routine with no extra action
			the_obj{"ButtonPress-1:XY"} := press_op := attach_start_noproc(the_objs);
		end if;
				
		if is_procedure(dg) then 		-- attach the drag routine with extra action
			the_obj{"B1-Motion:XY"} := drag_op := attach_drag(the_objs,dg,horiz_vert);		-- start the drag
		else								-- attach the start routine with no extra action
			the_obj{"B1-Motion:XY"} := drag_op := attach_drag_noproc(the_objs,horiz_vert);
		end if;
	
		if is_procedure(dg_end) then  		-- attach termination routine
			the_obj{"ButtonRelease-1:XY"} := release_op := attach_end(the_objs,dg_end);
		else								-- attach the termination routine with no extra action
			the_obj{"ButtonRelease-1:XY"} := release_op := attach_end_noproc(the_objs); 
		end if;
		
		ops_in_drag_mode(current_drag_mode) ?:= {}; ops_in_drag_mode(current_drag_mode)(the_obj) := [press_op,drag_op,release_op];
					-- save the operations associated with the object in the current  mode
		
	end loop;
	
end w_make_draggable;

procedure attach_end(the_objs,dg_end);		-- bind the object into the termination routine

	return lambda(xy); 
		was_dragging := the_objs;			-- note the objects that were being dragged
		[now_abs_x,now_abs_y] := xy; 
		now_abs_x := unstr(now_abs_x); now_abs_y := unstr(now_abs_y);
		dg_end(the_objs,dropped_at := [now_abs_x,now_abs_y]); 
	end lambda;		 					-- note the point at which the drag ended

end attach_end;

procedure attach_end_noproc(the_objs);	-- bind the object into the termination routine

	return lambda(xy); 
		was_dragging := the_objs;		-- note the objects that were being dragged
		[now_abs_x,now_abs_y] := xy; 
		now_abs_x := unstr(now_abs_x); now_abs_y := unstr(now_abs_y);
		dropped_at := [now_abs_x,now_abs_y]; 	-- note the point at which the drag ended
	end lambda;		

end attach_end_noproc;

procedure attach_start(the_objs,dg_start);		-- drag start routine generator

	return lambda(xy);
		was_dragging := the_objs;		-- note the objects being dragged
		[start_abs_x,start_abs_y] := xy; 
		start_abs_x := unstr(start_abs_x); start_abs_y := unstr(start_abs_y);
		
		drag_offs_x := drag_offs_y := [];	-- keep vector of displacements
		
		for obj in the_objs loop
			[place_x,place_y] := obj.place();
			drag_offs_x with:= (place_x - start_abs_x); drag_offs_y with:= (place_y - start_abs_y);
			obj.raise(OM);		-- raise dragged object to top level in rendering order
		end loop;
		
		dg_start(the_objs,[start_abs_x,start_abs_y]);		-- call the supplementary routine

	end lambda;

end attach_start;

procedure attach_start_noproc(the_objs);	-- drag start routine generator; no action version

	return lambda(xy);
		was_dragging := the_objs;		-- note the objects being dragged
		[start_abs_x,start_abs_y] := xy; 
		start_abs_x := unstr(start_abs_x); start_abs_y := unstr(start_abs_y);
		
		drag_offs_x := drag_offs_y := [];	-- keep vector of displacements
		
		for obj in the_objs loop
			[place_x,place_y] := obj.place();
			drag_offs_x with:= (place_x - start_abs_x); drag_offs_y with:= (place_y - start_abs_y);
			obj.raise(OM);		-- raise dragged object to top level in rendering order
		end loop;

	end lambda;

end attach_start_noproc;

procedure attach_drag(the_objs,dg,horiz_vert);	-- drag routine generator 
	var parx,pary;
	
	parent := the_objs(1)("parent");
	parx := parent("width"); pary := parent("height");
	parx -:= 2; pary -:= 2; 
	 
	return lambda(xy);		-- object dragging demo: drag routine
		
		[now_abs_x,now_abs_y] := xy; 
		now_abs_x := unstr(now_abs_x); now_abs_y := unstr(now_abs_y);
		
		for obj = the_objs(j) loop
			nax := ((now_abs_x + drag_offs_x(j)) max 0) min parx; nay := ((now_abs_y + drag_offs_y(j)) max 0) min pary;
			
			if horiz_vert = 0 then
				obj("place,x,y") := str(nax) + "," + str(nay);
			elseif horiz_vert = 1 then
				obj("place,x") := str(nax);
			else
				obj("place,y") := str(nay);
			end if;

		end loop;

		dg(the_objs,[nax,nay]);		-- call the supplementary routine, passing the list of all objects in the set as a parameter

	end lambda;
	
end attach_drag;

procedure attach_drag_noproc(the_objs,horiz_vert);	-- drag routine generator; no action 
	var parx,pary;
	
	parent := the_objs(1)("parent");
	parx := parent("width"); pary := parent("height"); 

	return lambda(xy);		-- object dragging demo: drag routine
		[now_abs_x,now_abs_y] := xy; 
		now_abs_x := unstr(now_abs_x); now_abs_y := unstr(now_abs_y);

		for obj = the_objs(j) loop

			nax := ((now_abs_x + drag_offs_x(j)) max 0) min parx; nay := ((now_abs_y + drag_offs_y(j)) max 0) min pary;
			
			if horiz_vert = 0 then
				obj("place,x,y") := str(nax) + "," + str(nay);
			elseif horiz_vert = 1 then
				obj("place,x") := str(nax);
			else
				obj("place,y") := str(nay);
			end if;

		end loop;

	end lambda;
	
end attach_drag_noproc;

	procedure make_drop_sensitive(the_obj,drop_response);	
										-- build response for mouse entry event (by drop)
		the_obj{"Enter:xy"} := lambda(xy);		-- this is the mouse entry code
		wd := was_dragging; was_dragging := OM;		-- was_dragging is the list of objects being dragged

		if wd /= OM and the_obj /= wd(1) then	--  dropped on object other than itself
			was_dragging := OM;
			drop_response(the_obj,wd(1));		-- note the drop-on event
		end if;
	end lambda;

end make_drop_sensitive;

procedure near(xy,ab); return abs(unstr(xy(1)) - ab(1)) + abs(unstr(xy(2)) - ab(2)) < 5; end near;

procedure c_make_draggable(the_objs,dg_start,dg,dg_end,horiz_vert);		-- make a canvas item draggable

	for the_obj in the_objs loop
		if is_procedure(dg_start) then 		-- attach the start routine with extra action
			the_obj{"ButtonPress-1:xy"} := press_op := c_attach_start(the_objs,dg_start);
		else								-- attach the start routine with no extra action
			the_obj{"ButtonPress-1:xy"} := press_op := c_attach_start_noproc(the_objs);
		end if;
				
		if is_procedure(dg) then 		-- attach the drag routine with extra action
			the_obj{"B1-Motion:xy"} := drag_op := c_attach_drag(the_objs,dg,horiz_vert);		-- start the drag
		else								-- attach the start routine with no extra action
			the_obj{"B1-Motion:xy"} := drag_op := c_attach_drag_noproc(the_objs,horiz_vert);
		end if;
	
		if is_procedure(dg_end) then  		-- attach termination routine
			the_obj{"ButtonRelease-1:xy"} := release_op := c_attach_end(the_objs,dg_end);
		else								-- attach the termination routine with no extra action
			the_obj{"ButtonRelease-1:xy"} := release_op := c_attach_end_noproc(the_objs); 
		end if;
	end loop;

	ops_in_drag_mode(current_drag_mode) ?:= {}; ops_in_drag_mode(current_drag_mode)(the_obj) := [press_op,drag_op,release_op];
					-- save the operations associated with the object in the current  mode

end c_make_draggable;

procedure c_attach_start_noproc(the_objs);	-- drag start routine generator; no action version

	return lambda(xy);
		[start_canv_x,start_canv_y] := xy; 
		start_canv_x := float(unstr(start_canv_x)); start_canv_y := float(unstr(start_canv_y));
	
		start_coords_obj := [[unstr(x): x in the_obj("coords")]: the_obj in the_objs];	
		for the_obj in the_objs loop the_obj.raise(OM);	end loop;
						-- raise dragged objects to top level in rendering order
	end lambda;

end c_attach_start_noproc;

procedure c_attach_start(the_objs,dg_start);	-- drag start routine generator

	return lambda(xy);
		[start_canv_x,start_canv_y] := xy; 
		start_canv_x := float(unstr(start_canv_x)); start_canv_y := float(unstr(start_canv_y));
	
		start_coords_obj := [[unstr(x): x in the_obj("coords")]: the_obj in the_objs];	
		for the_obj in the_objs loop the_obj.raise(OM);	end loop;
						-- raise dragged objects to top level in rendering order
		dg_start(the_objs,[start_canv_x,start_canv_y]);		-- call the supplementary routine

	end lambda;

end c_attach_start;

procedure c_attach_drag_noproc(the_objs,horiz_vert);	-- drag routine generator; no action 

	return lambda(xy);		-- object dragging demo: drag routine
		[now_canv_x,now_canv_y] := xy; 
		now_canv_x := float(unstr(now_canv_x)); now_canv_y := float(unstr(now_canv_y));
		
		delta_x := now_canv_x - start_canv_x; delta_y := now_canv_y - start_canv_y;

		for the_obj = the_objs(k) loop 

			if horiz_vert = 0 then 
				now_coords_stg := "" +/ [str(x + if odd(j) then delta_x else delta_y end if) + " ": 
															x = start_coords_obj(k)(j)];
			elseif horiz_vert = 1 then 
				now_coords_stg := "" +/ [str(x + if odd(j) then delta_x else 0.0 end if) + " ": 
															x = start_coords_obj(k)(j)];
			else
				now_coords_stg := "" +/ [str(x + if even(j) then delta_y else 0.0 end if) + " ": 
															x = start_coords_obj(k)(j)];
			end if;
			
			the_obj("coords") := now_coords_stg;

		end loop;
		
	end lambda;
	
end c_attach_drag_noproc;

procedure c_attach_drag(the_objs,dg,horiz_vert);	-- drag routine generator 

	return lambda(xy);		-- object dragging demo: drag routine
		[now_canv_x,now_canv_y] := xy; 
		now_canv_x := float(unstr(now_canv_x)); now_canv_y := float(unstr(now_canv_y));
		
		delta_x := now_canv_x - start_canv_x; delta_y := now_canv_y - start_canv_y;

		for the_obj = the_objs(k) loop 

			if horiz_vert = 0 then 
				now_coords_stg := "" +/ [str(x + if odd(j) then delta_x else delta_y end if) + " ": 
															x = start_coords_obj(k)(j)];
			elseif horiz_vert = 1 then 
				now_coords_stg := "" +/ [str(x + if odd(j) then delta_x else 0.0 end if) + " ": 
															x = start_coords_obj(k)(j)];
			else
				now_coords_stg := "" +/ [str(x + if even(j) then delta_y else 0.0 end if) + " ": 
															x = start_coords_obj(k)(j)];
			end if;

			the_obj("coords") := now_coords_stg;

			dg(the_obj,[now_canv_x,now_canv_y]);		-- call the supplementary routine

		end loop;

	end lambda;
	
end c_attach_drag;

procedure c_attach_end_noproc(the_objs);	-- end drag routine generator; no action version

	return lambda(xy); 
		was_dragging := the_objs;		-- note the object that was being dragged
		[now_canv_x,now_canv_y] := xy; 
		now_canv_x := unstr(now_canv_x); now_canv_y := unstr(now_canv_y);
		dropped_at := [now_canv_x,now_canv_y]; 	-- note the point at which the drag ended
	end lambda;		

end c_attach_end_noproc;

procedure c_attach_end(the_objs,dg_end);	-- end drag routine generator

	return lambda(xy); 
		was_dragging := the_objs;		-- note the object that was being dragged
		[now_canv_x,now_canv_y] := xy; 
		now_canv_x := unstr(now_canv_x); now_canv_y := unstr(now_canv_y);
		dg_end(the_objs,dropped_at := [now_canv_x,now_canv_y]);
			 	-- note the point at which the drag ended
	end lambda;		

end c_attach_end;

end drag_pak;

class ifprinter;				-- class for conditional printing
	class var pif := false;		-- switch to turn printing on
	procedure create();			-- creation routine
end ifprinter;

class body ifprinter;			-- class for conditional printing

	procedure self(x); 		-- prints its argument
		if not pif then return; end if;
		print(if is_tuple(x) then join(x,",") else x end if);
	end;

	procedure create();			-- creation routine
	end create;

end ifprinter;

program test;	-- test of the main widget class
use tkw,ifprinter;		-- use the main widget class

var Tk;																	-- the Tk interpreter
var printer;															-- various global variables for testing
var lb,lb2,e,msg,the_menu,the_menu2,te,sc,ca,imaje,imaje2,cw,ov,arc,img;	-- for basic_tests
var nt,ntca,ntmsg,obj_of_tag := { },td,blot,tdb,tdb2,tdb3;				-- for canvas_tests
var check1,check2,rad1,rad2;				-- for canvas_tests
var img_canv;							-- for image_tests

	Tk := tkw();					-- create the Tk interpreter
	printer	:= ifprinter(); 		-- create a conditional printer
	pif := true;	-- switches printing on
	img := Tk("image","orchid.GIF"); 		-- read an image file to create an image

--	basic_tests;		-- do first group of basic tests
--	canvas_tests;		-- do second group of tests: canvas tests
--	atext_widget_tests;	-- do third group of tests: text widget tests OK
--	dialog_tests;		-- do fourth group of tests: standard dialog tests OK
--	listbox_tests;		-- do fifth group of tests: listbox tests
	primes_demo;		-- do prime factorization demo
--	misc_tests;			-- small group of miscellaneous tests
	
--debug_trace := "Step1";

--show_commands := true;			-- start to trace the commands to tk
	
--	lab := Tk("label","n will appear here"); lab("side") := "top";
--	sb := Tk("scrollbar","h,10"); sb("side") := "top"; --sb("fill") := "x";
	
--	junk:=printer("frame height,width are: ",nw("height,width")); 
--	junk:=printer("attributes of this canvas are ",c("background;borderwidth;relief;height"));

--	Tk.quit();			-- just quit Tk main loop

	Tk.mainloop();		-- enter the Tk main loop

procedure misc_tests;		-- small group of miscellaneous tests

end misc_tests;

procedure drag;		-- object dragging procedure
end drag;

procedure primes_demo;		-- prime factorization demo
	lb := Tk("label","n will appear here"); lb("side,anchor") := "top,w";
	lb2 := Tk("label","factorization will appear here"); lb2("side,anchor") := "top,w";
	ca := Tk("frame","300,20"); ca("side") := "top";
	button := ca("button","xxx"); button("side") := "left";
	button("text") := "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz";
	button2 := ca("button","xxx"); button2("side") := "left";
	button2("text") := "zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz";
--	button{"B1-Motion"} := beep;
	button{"B1-Motion:xy"} := showxy;
	button2{"B1-Motion:xy"} := showxy2;
end primes_demo;

procedure showxy(xy);		-- 1-parameter callback routine
	[x,y] := xy; x_and_y := 2 * abs(unstr(x) * 1000 + unstr(y)) + 3;
	npf := #(pf := primefacts(x_and_y));
	lb(OM) := "n: " + str(x_and_y);
	lb2(OM) := "factors: " +/ [str(p) + if j < npf then " * " else "" end if: p = pf(j)];
						-- write number and factor to label 
end showxy;

procedure showxy2(xy);		-- 1-parameter callback routine
	[x,y] := xy; x_and_y := abs(unstr(x) * 1000 + unstr(y));
	npf := #(pf := primefacts(x_and_y));
	lb(OM) := "n: " + str(x_and_y);
	lb2(OM) := "factors: " +/ [str(p) + if j < npf then " * " else "" end if: p = pf(j)];
						-- write number and factor to label 
end showxy2;

procedure primefacts(n); 		-- prime factorization routine for demo
	
	facts := [];
	while even(n) loop facts with:= 2; n/:= 2; end loop;
	while n mod 3 = 0 loop facts with:= 3; n/:= 3; end loop;
	
	while n > 1 and (exists m in [3..fix(sqrt(float(n))) + 1] | n mod m = 0) loop
		facts with:= m; n/:= m;
	end loop;
	
	return if n > 1 then facts with n else facts end if;
	
end primefacts;

procedure listbox_tests;		-- fifth group of tests: listbox tests
	listbox_top := Tk("toplevel","300,300");		-- create a toplevel
	b := listbox_top("button","Show listbox selection"); b("side") := "top"; b{OM} := showlis;
	lb := listbox_top("listbox",str(lb_len := 10)); 		-- create a listbox
	lb("side") := "bottom";
	
	more := ["more_" + str(j): j in [1..lb_len]];
	lb(1..0) := [if j = 1 then "\"Insert Stuff\"" elseif j = 2 then "\"Delete Stuff\"" 
									else "choice_" + str(j) end if: j in [1..lb_len - 1]] + more;
	lb{OM} := pickit;		-- set the command to be executed when the listbox is clicked
---> Working Here
	print("length of listbox: ",#lb);
	print("bounding box of line 2: ",lb.bbox(2)," ",lb.bbox(3)," ",lb.bbox(1));  -- some problem
	print("listbox end: ",lb.index("end"));

	e := listbox_top("entry","70"); e("side") := "top"; 
	msg := listbox_top("message","Twas Brillig");
	msg("side") := "top";				-- create a message in the frame, and pack it into the frame
	msg("width") := 300;				

end listbox_tests;

procedure showlis;			-- show the listbox selection 
	print("listbox selection is: ",lb(OM)); lb("hilight") := 6;
end showlis;

procedure image_tests;		-- sixth group of tests: image tests
	img_top := Tk("toplevel","300,300");		-- create a toplevel
	img_canv := img_top("canvas","300,300"); img_canv("side") := "top";
	test_image := img_canv("image",img); 			-- create and place image
	test_image("coords,anchor") := "5,5;nw";		
	test_image{OM} := clearead_img;

	print(img("gamma,file")); print(test_image("anchor,tags,image"));	
			-- test the fetch of some internal and relative image attributes
	print("pixel before: ",img(11,11)," ",img("data"));			-- test the stuff_im operation
	img.stuff_im("#ffffff,#ffffff,#ffffff;#ffffff,#ffffff,#ffffff;#ffffff,#ffffff,#ffffff","10,10,12,12");
	print("pixel after: ",img(11,11)," ",img("data"));
			
end image_tests;

procedure clearead_img();			-- clear or read the image 'img'

	img("file") := "orchidbig.GIF";	
	test_image2 := img_canv("image",img); 			-- create and place a second image
	test_image2("coords,anchor") := "80,5;nw";
	print("img(5,10): ",img(5,10));			-- fetch and print the pixel value
	
	print("subrectangle extraction: ",imsub := img("5,5".."100,100"));	-- test subrectangle extraction and insertion 
	img("100,100".."195,195") := imsub;			-- re-insert the image
	img.write_im("abs_img_test.gif","from;1,1,250,250");
	img.dither();
	
	read_copy2 := Tk("image","orchid.GIF");
	img.copy_im(read_copy2,"zoom;4,4");
end clearead_img;

procedure dialog_tests;		-- fourth group of tests: standard dialog tests

	dialog_win := Tk("toplevel","10,10");
	dialog_win("ask","title,message,labels,default") := "Pick a Case;Pick one of the following cases;Case A,Case B,Case C;2";
			 print(dialog_response);
	Tk("ask_ok","type,default,message") := "ok,ok,Proceed"; print(dialog_response);
	Tk("ask_ok","type,default,message") := "yesno,no,Proceed"; print(dialog_response);
	Tk("ask_file","") := "";  print("open_file: ",dialog_response);
	Tk("ask_save_file","") := "";  print("save_file: ",dialog_response);
	Tk("ask_color","initialcolor,title") := "red,Pick a Color"; print("get_color: ",dialog_response);

end dialog_tests;

procedure atext_widget_tests;		-- third group of tests: text widget tests

	tnt := Tk("toplevel","300,300");		-- create a toplevel
	tntex := tnt("text","100,30"); 		-- 100 chars, 30 lines
	tntex(OM) := "This is a full-fledged text widget, \ncontaining multiple lines of rich text"; 
	tntex("side,anchor") := "top;nw"; print("tntex('1.2'..'1.4'): ", tntex("1.2".."1.4"));
	tntex("1.2".."1.4") := "";  tntex("2.2".."2.1") := "xxxx";
	print("tntex.bbox: ",tntex.bbox("1.2")); print("tntex.linebox: ",tntex.linebox("1.0")); -- ????

	tntex.insert_image("1.2",["image",img]); tntex.insert_image("1.8",["image",img]); 
	tntex.insert_image("2.5",["image",img]);
	print("tntex('images'): ",tntex("images"));

	but1 := tnt("button","Embedded button"); tntex.insert_widget("1.4",["window",but1]);
	print("tntex('widgets'): ",tntex("widgets"));

	tntex.tag_add("Big","1.1,1.10,2.1,2.10"); 
	tntex.tag_remove("Big","1.5,1.8,2.5,2.8"); tntex("Big","font") := "{times 48 bold}";

	print("tntex.tag_nextrange('Big','1.11','end'): ",tntex.tag_nextrange("Big","1.11","end"));
	print("tntex.tag_prevrange('Big','1.11','end'): ",tntex.tag_prevrange("Big","1.0","end"));

end atext_widget_tests;

procedure canvas_tests;		-- second group of tests: canvas tests
	
	nt := Tk("toplevel","300,300");		-- create a toplevel
	ntca := nt("canvas","300,300"); ntca("side") := "top";

	msgtop := Tk("toplevel","300,100");		-- create a toplevel to write messages to
	ntmsg := msgtop("message","Messages will appear here"); ntmsg("side") := "top";
	ntmsg("width") := "500";
	
	boxno := 0;		-- count of boxes in following loop
	
	for i in [1..4], j in [1..4] loop		-- set up an array of 16 small images
		
		boxno +:= 1;							-- increment count of boxes
		imajeij := ntca("image",img); 			-- create and place image
		imajeij("coords,anchor") := (ijplace := str(-70 + 75 * i) + "," + str(-70 + 75 * j)) + ";nw";
		imajeij{OM} := make_response(ijplace);		-- pass the tag to the response function		
		ntca.addtag_nearest(ijplace,ijplace,OM,OM);
		obj_of_tag(ijplace) := imajeij;			-- map the identifying tag into the image object
		
	end loop;
	
	blot := ntca("oval","0,0,100,100"); blot("fill") := "blue"; blot{OM} := scale_me;
	
	print("nearest to 5,5: ",ntca.find_nearest(5,5));
--	print("\nabove 1: ",ntca.find_after(1));
--	print("\nbelow 3: ",ntca.find_before(3));
--	for obj in ntca.find_all() loop print("\nall: ",obj); end loop;
--	print("\nIn"); for obj in ntca.find_in("0,0,100,100") loop print("\nIn: ",obj); end loop;
--	print("\nTouching"); for obj in ntca.find_touching("0,0,100,100") loop print("\nTouching: ",obj); end loop;
--	print("\nWith tag or id"); for obj in ntca.find("5,5") loop print("\nWith: ",obj); end loop;
	print("ntca('tags'): ",ntca("tags"));
	
	td := Tk("toplevel","100,100");		-- create a toplevel
	tdf := td("frame","100,20"); tdf("side") := "top"; 
	tdb := tdf("button","Close Me"); tdb("side") := "left"; tdb{OM} := close_td;
	tdb2 := tdf("button","Flash Him"); tdb2("side") := "left"; tdb2{OM} := flash3;
	tdb3 := tdf("button","Execute Close Op"); tdb3("side") := "left"; tdb3{OM} := do_tdb;
	tdb4 := tdf("button","Set Check Drop Rad"); tdb4("side") := "left"; tdb4{OM} := set_check1;
	tdb5 := tdf("button","Set Rad Drop Check"); tdb5("side") := "left"; tdb5{OM} := set_radio1;

	check1 := tdf("checkbutton","Check1"); check1("side") := "left"; check1("variable") := "checkvar1";
 	check2 := tdf("checkbutton","Check2   "); check2("side") := "left"; check2("variable") := "checkvar2";
	check1{OM} := print_checks; check2{OM} := print_checks;
	
 	rad1 := tdf("radiobutton","Radio1"); rad1("side") := "left"; rad1("variable,value") := "radiovar,Radio1";
 	rad2 := tdf("radiobutton","Radio2"); rad2("side") := "left"; rad2("variable,value") := "radiovar,Radio2";
	rad1{OM} := print_checks; rad2{OM} := print_checks;
	
	tde := td("entry","100"); tde(OM) := "Humongous"; tde("side") := "top"; print("tde('end'): ",tde("end"));
	tde("insert") := 3; print("tde('insert'): ",tde("insert"));
	
	ctex := ntca("text","This is a another canvas text item"); 
	ctex("anchor,font") := "nw,{Times 24 bold}";	ctex("coords") := "10,10"; 
--	icursor(tag_or_id,m);
	ctex("insert") := 7; print("ctex('insert'): ",ctex("insert"));
	print("ctex.index_item('end'): ",ctex.index_item("end"));
	print("ctex(2..4): ",ctex(2..4));ctex(10..10) := "yyyyyy"; ctex(2..4) := "";

end canvas_tests;

procedure print_checks();		-- print the values of all the radio and check button variables
	print("checkvar1: ",Tk.getvar("checkvar1")," checkvar2: ",Tk.getvar("checkvar2"),
													" radiovar: ",Tk.getvar("radiovar"));
	print("selected-checkvar1: ",check1("selected")," selected-checkvar2: ",check2("selected"),
					" selected-radiovar1: ",rad1("selected")," selected-radiovar2: ",rad2("selected"));
end print_checks;

procedure set_check1();		-- set the first checkbox
	check1("selected") := 1;
	rad1("selected") := 0;
end set_check1;

procedure set_radio1();		-- set the first radio button
	rad1("selected") := 1;
	check1("selected")  := 0;
end set_radio1;

procedure do_tdb();		-- invoke operation of tdb button
	tdb.invoke_button();
end do_tdb;

procedure flash3();		-- flash button 3
	tdb3.flash();
end flash3;

procedure scale_me();		-- scale item with given tag or id
	blot.scale_item(0,0,0.5,0.5);
end scale_me;

procedure close_td();		-- close window td
	td.destroy();
end close_td;

procedure make_response(ijplace);		-- create a response closure
	return lambda(); respond(ijplace); end lambda;
end make_response;

procedure respond(tag);		-- internal handler routine to print tag of clicked image
--print("respond: ",tag," ",ntca);
	ntca.addtag_in("NewTag","10,10,250,250"); ntca.addtag_in("Cosi fan Tutte",OM);
	ntca.move(tag,1,1); 
	show("clicked: "+ obj_of_tag(tag)("tags"));
end respond;

procedure show(stg); ntmsg(OM) := stg; end show;

procedure basic_tests;		-- first group of basic tests
	
	nw := Tk("frame","50,50"); c := nw("canvas","150,250");			-- create a frame and canvas
	nw("side") := "top";									-- pack the frame into the top level window
	
	b1 := Tk("button","Put text w. tags"); b2 := Tk("button","Get tags");	-- create 4 buttons in the top window
	b3 := Tk("button","Tag ranges"); b4 := Tk("button","Tag font");
	
	b1("side") := "left"; b2("side") := "left";	b3("side") := "left"; b4("side") := "left";
						-- pack the buttons into the top level window
	b1{OM} := put_tt; b2{OM} := get_tgs; b3{OM} := get_tgrang; b4{OM} := set_tfont;
	

	b1 := nw("button","Bouton 1"); b2 := nw("button","Bouton 2");	-- create 4 buttons in the frame
	b3 := nw("button","Put 3..5 into Text widget"); b4 := nw("button","Get 3..5 from Text widget");

	b1("side") := "left"; b2("side") := "left";	b3("side") := "left"; b4("side") := "left";
															-- pack the buttons into the frame
	b1{OM} := beep; b2{OM} := move_oval; b3{OM} := put_text; b4{OM} := get_text;
	
	lab := nw("label","Now is the time for all good men!");			-- create a label in the frame
	lab("side") := "bottom";										-- pack it into the frame
	msg := nw("message","Twas Brillig, and the slithy toves\nDid gyre and gymbal in the wabe");
	msg("side") := "top";				-- create a message in the frame, and pack it into the frame
	
	top := Tk("toplevel","150,50");					-- create a new top-level window
	top("title") := "Topper";						-- set its title
	
	e := top("entry","70"); e("side") := "top"; e("relief") := "raised";
				-- create an entry field in the new toplevel, and pack the entry field into the toplevel
	e(OM) := 10 * "12345678901234567890" + "a" +  10 * "12345678901234567890";
	
	te := top("text","70,10"); te("side") := "top"; te("relief") := "sunken";
				-- create a text widget in the new toplevel, and pack the text widget into the toplevel
	te("tag1",OM) := beep; te("tag2",OM) := show_char; -- te("cursor") := "pirate"; 
	te.insert_tt("end","te.bbox ,tag3,set_scale(0) ,tag4,set_scale(90) ,tag5,to_entry ,tag6, " + 
			"xview(100) ,tag7,xview_percent(50) ,tag8"); 
	te("tag3",OM) := p_bbox; te("tag4",OM) := set_scale0; 
	te("tag5",OM) := set_scale90; te("tag6",OM) := to_entry;
	te("tag7",OM) := xview100; te("tag8",OM) := xview_perc;
	
	sc := top("scale","0,100"); sc("side") := "top"; sc("orient") := "horizontal"; sc("length") := "350";
				-- create a slider widget in the new toplevel, and pack the slider into the toplevel

	--sc("side,orient,length") := "top,horizontal,150";		-- ********** ?????? **********

	ca := top("canvas","300,300"); ca("side") := "top";
				-- create a canvas in the new toplevel, and pack the canvas into the toplevel
	
	imaje := ca("image",img); imaje2 := ca("image",img);	-- insert the image into the canvas twice
--print("imaje: ",imaje);
	imaje("coords,anchor") := "50,50;nw"; junk:=printer("imaje('coords'): ",imaje("coords"));
	imaje{OM} := beep2;
	imaje2("coords,anchor") := "0,100;nw"; 
	imaje2{OM} := beep;
	
	ov := ca("oval","30,30,60,60"); rect := ca("rectangle","70,30,100,60");
														-- create an oval and a rectangle in the canvas
	ov("fill") := "red"; rect("fill") := "blue";		-- make them visible in red and blue
	
	-- now go on to create an arc, bitmap, image, line, polygon, text, and widget items in the canvas

							-- first create an arc, line, and polygon
	arc := ca("arc","110,30,140,60"); arc("start") := "45"; arc("extent") := "135"; arc("fill") := "green";	
	line := ca("line","190,30,220,30,225,60,185,60"); line("fill") := "brown"; line("smooth") := "true";
	poly := ca("polygon","150,30,180,30,185,60,150,60"); poly("fill") := "yellow";
	
	junk:=printer("poly attributes: ",poly("fill,outline,width,smooth,splinesteps"));
	junk:=printer("line attributes: ",line("fill,width,smooth,splinesteps"));
					-- access and print the poly and line attributes
	junk:=printer("canvas attributes: ",ca("height,width"));		-- access and print the canvas attributes

	rect.addtag("BlueRect"); rect.addtag("LooksGood"); junk:=printer("rect attributes: ",rect("width,tags"));
	junk:=printer("rect bbox: ",rect("bbox"));
	junk:=printer("rect and oval bbox: ",ca.bbox_tags("1,2"));
	
	rect.deltag("LooksGood"); junk:=printer("rect attributes: ",rect("width,tags"));
	rect.addtag("LooksVeryGood"); junk:=printer("rect attributes: ",rect("width,tags"));
	ca.deltag_if("BlueRect","LooksVeryGood"); junk:=printer("rect attributes after deltag_if: ",rect("width,tags"));
	junk:=printer(str(ca.canvasx(100,OM)) + " " + str(ca.canvasy(100,OM)));
	
	ca("BlueRect",OM) := beep; ov{OM} := animate; arc{OM} := del4;

							-- next create a bitmap and image
	bm := ca("bitmap","60,90"); bm("bitmap") := "hourglass";		-- use a built-in bitmap
--	im := ca("image","100,100"); im("bitmap") := the_image;		
							-- now create a canvas text item and a canvas widget
	ctex := ca("text","This is a canvas text item"); 
	ctex("anchor,font") := "w,{Times 24 bold}";	ctex("coords") := "100,90"; 
	junk:=printer("ctex('coords'): ",ctex("coords"));
	
	junk:=printer("ctex: ",ctex("coords,font")); junk:=printer("rect: ",rect("coords,fill"));
	
	bb1 := top("button","Yet another button to press");
				-- create a NEW button in the SAME toplevel as the canvas
	cw := ca("widget",bb1); cw("coords") := "40,40"; 		-- make this button a canvas widget 
	junk:=printer("cw('coords'): ",cw("coords")); bb1{OM} := movecw;
	
--	bm := ca("bitmap","100,90"); bm("bitmap") := "hourglass";		-- use a built-in bitmap

	--dchars(tag_or_id,m,n);

	menub := nw("menubutton","Menu"); menub("side") := "bottom";	-- create a menubutton
	the_menu := menub("menu","tearoff"); 
	the_menu(1..0) := "Item1,Item2,Item3,Item4";		-- add 4 items to the menu
	menub("menu") := the_menu;

	menub := nw("menubutton","Menu2"); menub("side") := "bottom";	-- create a menubutton
	the_menu2 := menub("menu","normal"); 
	the_menu2(1..0) := "iItem1,iItem2,iItem3,iItem4";		-- add 4 items to the menu
	menub("menu") := the_menu2;

	the_menu(1,OM) := beep2;			-- set command for first item, "Menu"
	the_menu(2,OM) := drop4;			-- set command for second item
	the_menu(3,OM) := invoke1;		-- set command for third item

	the_menu2(1,OM) := beep;			-- set command for first item, "Menu2"
	the_menu2(2,OM) := beep2;		-- set command for second item
	the_menu2(3,OM) := beep3;		-- set command for third item
	the_menu2(4,OM) := add5;			-- set command for fourth item
	
--	junk:=printer("menu entry info: ",the_menu2(1..1));					-- get label info for range of entries
--	junk:=printer("menu entry info: ",the_menu2(2,"label"));			-- get specified info for individual entry

end basic_tests;		

	procedure pickit;		-- call test procedure for listbox command
		e(OM) := str(lbom := lb(OM));		-- display the current selection
		msg("text") := str(lbom);		-- display the current selection
		if lbom = 1 then lb(8..7) := "inserted1,inserted2"; end if;
		if lbom = 2 then e(OM) := "Deleting"; lb(8..9) := ""; end if;
		if lbom = 3 then e(OM) := lb(8..9); end if;
		if lbom = 4 then e(OM) := str(#lb(8..9)); end if;		-- number of listbox characters
--		print(lb(OM));
	end pickit;
	
	procedure beep;			-- call the Tk beep utility
		TK.beeper();
	end beep;
	
	procedure beep2; TK.beeper(); TK.beeper(); end beep2;
	procedure beep3; TK.beeper(); TK.beeper(); TK.beeper(); end beep3;

	procedure add5; the_menu2(5..4) := "More"; end add5;
	procedure drop4; the_menu(4..4) := ""; end drop4;
	procedure invoke1; the_menu.invoke(1); end invoke1;

					-- procedures for text widget tests 
	procedure get_text; e(OM) := te("1.3".."1.5"); end get_text;
	procedure put_text; te("1.3".."1.5") := e(OM); end put_text;
	procedure put_tt(); te.insert_tt("end","This ,tag1, that ,tag2, the other"); end put_tt;
	procedure get_tgs(); print(te.tag_names(OM)); end get_tgs;		-- get all the tags in the text widget
	procedure get_tgrang(); print(te("tag","tag1")); end get_tgrang;	-- get the range of tag 1
	procedure set_tfont();
		te("tag1","font") := "{times 48 bold}"; te.mark_set("Jill","1.3");
		print("search for 'His' ",te.search("forward,nocase","His","1.0","1.10")); 
		print("search for 'His', exact case ",te.search("forward","His","1.0","1.10")); 
		print("search for 'zm' ",te.search("forward,nocase","zm","1.0","1.10")); 
	end set_tfont;
	procedure show_char(); 
		print(te.index("current")," ",te("marks")," ",te.mark_next(1.0),
													" ",te.mark_next(1.10)," ",te.mark_prev(1.10)); 
	end show_char;

	procedure p_bbox(); e(OM) := te.bbox("current"); end p_bbox; 
	procedure set_scale0(); sc(OM) := 0; end set_scale0; 
	procedure set_scale90(); 
		sc(OM) := 90; [i,j] := sc.coords(90); 
		e(OM) := sc.get(i,j) + " " + sc.identify(i,j) + " " + sc.identify(unstr(i) - 30,j) 
																+ " " + sc.identify(unstr(i) + 30,j); 
	end set_scale90;
	
	procedure xview100(); e("xview") := 100; end xview100;
	procedure xview_perc(); e("xpercent") := 50; end xview_perc;

	procedure del4(); ca.delete_items("4"); end del4;

	procedure to_entry(); 
		e(4..5) := "aa"; e(2..1) := "aa"; 
		e.select(5,10); print("selection: ",e.index("sel.first")," ",e.index("sel.last")," ",e.index("sel.last") /= OM);
	end to_entry;

	procedure animate();		-- animate the photo
		
		print("starting photo: ",time());
		for j in [50,49..1] loop			-- 1.5 seconds for 50 cycles, so about 30 cycles/sec.
			imaje2("coords") := str(j) + "," + str(j); Tk.update();
		end loop;
		print("ending photo: ",time());
		
	end animate;
	
	procedure movecw();		-- animate the button 
		print("starting button: ",time());
		for j in [50..300] loop		-- 6.5 seconds for 250 cycles, so about 35 cycles/sec.
			cw("coords") := str(j) + "," + str(j); Tk.update();
		end loop;
		print("ending button: ",time());
		
	end movecw;
	
	procedure move_oval();		-- move the oval
		ov("coords") := "200,200,300,300";
					-- note that canvas geometric objects must have an appropriate number of coordinates
	end move_oval;

end test;

-- 		*********** Syntactic and semantic conventions for the SETL widget class ***********

-- The SETL widget class is built on top of the Tk widget library, and the following discussion assumes 
-- some basic familirity with the operation of that library. The SETL widget class supports objects
-- of the single SETL class 'Tk' but of multiple internally distinguished kinds, corresponding to 
-- the kinds of Tk widgets and canvas items, namely button, menu, menubutton, frame, toplevel, 
-- label, message, scale, scrollbar, entry, listbox, text, canvas, and arc, bitmap, image, line, oval,
-- polygon, rectangle, canvas_text, and widget.

-- To initialize for use of SETL widgets one must create an initial widget object (the 'Tk interpreter')

-- Once this is done, additional widgets are created by calls of the form

--			new_widget := p(tk_type,principal_parameter), 	for example 	b := Tk("button","Click Me")

-- Here, p should be the intended parent widget of the new_widget, i.e. the one into which it will be 
-- placed by a subsequent geometry manager call. The principal_parameter required here depends in  
-- the following way on the type of the widget or other item being created: 

-- (1) buttons, menubuttons, labels, and messages: 		the text to be displayed by the widget
-- (2) frames, toplevels, text widgets, and canvases: 	the height and width, in the format height,width 
-- (3) canvas items:									the height and width, in the format height,width 
-- (4) single-line text entry fields: 					the width, in characters
-- (5) listboxes: 										the height, in lines
-- (6) menus:											the type, i.e. normal, tearoff, or cascade
-- (7) scrollbars:										the orientation, i.e. horrizontal or vertical
-- (8) scale (slider) widgets:							the slider's lower and upper values, as lower,upper
								
-- Once a widget or canvas item w has been created, it can be 'configured' (i.e its attributes can be set
-- or queried) by calls of the form

-- 				w("attr1,attr2,...") := "attr_val_1,attr_val_2,...";

-- where attr1,attr2,... is a list of widget attribute names, and attr_val_1,attr_val_2,... are
-- the corresponding attribute values. A comma-separated list of values can be used, but if commas
-- must occur in the attributes themselves, a semicolon-separated list of values can be used instead.
-- The semicolon is used as separator if any semicolons occur in the string on the right. A third
-- possiblity is to use a tuple of values on the right, e.g. 

-- 				w("attr1,attr2,...") := [attr_val_1,attr_val_2,...];

-- This form is appropriate if both commas and semicolons occur in some of the attributes, or if some 
-- of the attributes are procedures rather than strings, as in the 

-- 							w{OM} := procedure;

-- case described below. A final option is to write integer-valued attributes as integers, as e.g. in 

-- 							my_listbox("height") := 12;

-- Since Tk uses blanks as separators list-valued attributes (these are somewhat rare) can be written in that form,
-- as e.g in 

-- 					my_text_widget("tabs,padx,pady") := "1i left 2i right 31 center,5,5";

-- To define a widget's geometry manager, i.e. make it visible in the proper place within its parent widget,
-- calls of much the same syntactic form are used. Specifically, these are 

-- 				w("pack,attr1,attr2,...") := "attr_val_1,attr_val_2,...";

-- 				w("grid,attr1,attr2,...") := "attr_val_1,attr_val_2,...";

-- 				w("place,attr1,attr2,...") := "attr_val_1,attr_val_2,...";

-- These calls respectively invoke the Tk pack, grid, and place geometry managers. If the attribute name 'side', 
-- which occurs only for the 'pack' geometry manager, or one of the the attribute names 'row' or 'column',
-- which occurs only for the 'grid' geometry manager, appears at the start of the attribute list, 'pack' or 
-- 'grid' can be omitted. For example, one can write

--						my_button("side,padx,pady") := "top,5,5";

-- to pack a button into its parent frame. Note that only pack, grid, or place geometry manager options can
-- appear in the left-hand attribute lists of such calls. 

-- Syntactic constructs like

--								w("attr1,attr2,...")

-- can also be used on the right-hand side of SETL assignments. This returns a tuple consisting of the values of 
-- the attributes listed. 

-- In some cases SETL extends an object's Tk list of attributes to treat quatities set by special Tk operations 
-- using this same 'attribute' syntax. An example is the insertion cursor position attribute of entry widgets and
-- canvas text items, for which the syntax n := obj("insert") and obj("insert") := n is provided; likewise 
-- obj("end"), etc. 

-- Means for reading and setting the values of Tk variables, for example the special variables which
-- Tk associates with groups of radio buttons, are also provided, and use much the same syntax. Specifically,
-- if Tk is the master Tk interpreter object returned by the obligatory initial call Tk := tkw() (see above),
-- then 

--								Tk("varname")

-- returns, and

--								Tk("varname") := val;

-- sets, the value of the Tk variable 'varname'.

-- Each kind of Tk widget and canvas object can be assigned a parameterless SETL 'command' 
-- callback procedure which is invoked by the 'principal' event to which the widget or object is sensitive.
-- these 'principal' events are determined in the following way by the type of the widget or item: 
								 	 	
-- (1) buttons, menubuttons, checkbuttons, radiobuttons, and canvas items:			
--														button press events ()
-- (2) menus and listboxes:								button release events ()
-- (3) text fields and 1-line entry fields				loss of focus events  ()
-- (4) canvases,frames, and toplevels 					dragging motions ()

-- These commands are set up using the syntax

-- 						obj{OM} := SETL_procedure;

-- In a few special cases, the syntactic forms obj(OM) and obj(OM) := val; are used to retrive or assign an
-- widget's  principal attribute. These depend in the following way on the widget kind:

-- (1) listboxes:										obj(OM) is the (first) currently selected item
-- (2) text fields and 1-line entry fields				obj(OM) is all the text 
-- (3) text fields and 1-line entry fields				obj(OM) := stg sets all the text 
-- (4) labels and messages								obj(OM) := stg sets all the text 

-- The following operations, which use the SETL string and tuple 'slice' syntax are provided for manipulating
-- text within one-line and multi-line text widgets and various other widget-associated lists.

-- (1) text fields										obj(i..j) is the text between positions i and j
		-- note that these positions can have built-in forms (always string names) like line.char, 'end', etc.,
		-- and can also be strings defined by the obj.mark_set(name,place) command. These 'character indices'
		-- can also carry modiers, from which they are eparated by blanks. The allowed modifiers are + n chars,
		-- - n chars, + n lines, - n lines, linestart, lineend, wordstart, and wordend. 
-- (2) 1-line entry fields								obj(i..j) is the text characters i and j
-- (3) menus and listboxes:								the labels of all items between i and j
-- (4) text fields										obj(i..j) := stg sets the text between positions i and j
-- (5) 1-line entry fields								obj(i..j) := stg sets the text characters i and j

-- The syntax '#obj" is used for listbox, menus, text fields, for which it designates the number of entries or lines,
-- and for 1-line entry fields, where it designates the number of characters.

-- Additional comments on images, canvas items and text items: Images, canvas items and text items are treated as 
-- 'pseudo widgets', in that they are represented by objects of the tkw class. Canvas items can be: 
-- (1) geometric objects like ovals and rectangles; (2) images; (3) canvas text objects; (4) canvas widgets, 
--i.e. arbitrary widgets ebedded in a canvas; this can include nested canvases.
-- Text items can be images or text widgets.

-- The attributes of canvas items are: tags, and coords in all cases, plus 
	-- for canvas geometric objects: width, fill, outline, and stipple 
	-- for canvas images: anchor and image 
	-- for canvas text objects: anchor, width, fill, font, justify, stipple, and text 
	-- for canvas widgets: width, anchor, height, and window

-- The attributes of images and widgets in text are: 
	-- tags in all cases (calculated by regarding the image or widget as a character); also align, padx, pady;  plus 
	-- for text images: image, name
	-- for text widgets: create, stretch, window

-- The creation calls for items of this kind are:
	
--		cgeom := ca("oval,etc","coords");	ct := ca("text","initial_text");	cim := ca("image","image_name");
--											cw := ca("widget",widget_object);
--				tim := te("image","image_name");	tw := te("widget",widget_object);

-- Note that in the case of a canvas geometric object the coords parameter is a comma-separated list of integers
-- (defining either rectagle corners or polygon points). To create embedded widgets either in a canvas or in text
-- we must supply not a string but a pre-existing widget object as the second creation parameter; in this case
-- the creation call establishes a pointer relationship between the canvas or text and this object. 
-- The embedded objects are then configured using calls of the standard form obj("att,att,...") := values or
-- values := obj("att,att,..."). However, since the names anchor, width, height, padx, and pady are used both
-- for inherent and relative attributes, the relative variants of these attributes must be retrieved and set 
-- by using the modified names rel_anchor, rel_width, rel_height, rel_padx, and rel_pady.

-- For canvas geometric objects, canvas images, and canvas text objects the configuring assignment 
-- obj{OM} := SETL_proc; is allowed. This is also allowed for text images. The implied 'principal event'
-- is  for the canvas objects,  for images in text. Embedded widgets have their
-- own principal commands,

-- Note that Tk only allows a widget to be used in one place: it can be packed, used as a canvas widget
-- in a single canvas but not in two such, etc. If these implicit semantic rules are violated, unpredictable
-- graphical effects will result. Also, a widget created as a child of one toplevel cannot be used within
-- a canvas or text of a different toplevel. SETL uses of widgets must obey these same rules. (But none
-- of these restrictive rules apply to images.) Principal commands and other event responses intended 
-- for embedded widgets should be assigned to the underlying widget, not to the canvas widget item
-- containing them.

-- Tk image (photo image) objects should be created by a creation call using the top-level object Tk as parent,
-- e.g. img := Tk("image","file_name"); Images can then be configured in the same way as other objects,
-- that is by writing img("atts...") := "att_vals..."; The attributes of photo images are format, channel, data,
-- file, gamma, palette, height, and width. Assignment to the special attribute "file", e.g. in the form
-- img("file") := "file_name..." reads a new file into the image. img("file") := OM; clears the image.
-- img("data") := tuple_of_strings writes an image from calculated data.  img(top_left..bottom_right)
-- creates a new image by extracting the designated section of img; img(top_left..bottom_right) := img2
-- inserts img2 into the designated section of img. Note that when initially read an image has no defined
-- height or width, and so one can write to any part of the quadrant it occupies

-- Event handlers for the various kinds of mouse, keyboard, and other events to which Tk widgets and canvas items
-- are sensitive are set up by writing nominal assignments of one of the two the syntactic forms


--			widget("event_descriptor,event_fields_signature") := SETL_procedure;

--			textfield("tag_name","event_descriptor,event_fields_signature") := SETL_procedure;

--			canvas("tag_name","event_descriptor,event_fields_signature") := SETL_procedure;

-- The first form is used to assign callback procedures to widget-related events, and the second is used to 
-- assign callback procedures to tags in text fields and canvases. Examples are:

-- 				top_frame(":x,y") := my_drag_procedure;
-- 				text_widget("tag_name","") := my_hypertext_click_procedure;

-- In the general case, the event_fields_signature is a concatenation of single characters drawn from the 
-- string "#abcdfhkmopstvwxyABEKNRSTWXY"; these have the following meanings:

	-- #		event serial number							all events
	-- a		'above' field for event						configure event
	-- b		button number								buttonpress, buttonrelease
	-- c		event count field							expose, map
	-- d		event detail field							enter, leave, focusin, focusout
	-- f		focus value established by event				enter, leave
	-- h		height field								configure, expose
	-- k		keycode									keypress, keyrelease
	-- m		mode										enter, leave, focusin, focusout
	-- o		override redirect							map, reparent, configure
	-- p		place										placeontop, placeonbottom, circulate
	-- s		state				buttonpress, buttonrelease, enter, leave, keypress, keyrelease, motion
	-- t		time										all events
	-- v		value mask									configure event
	-- w		width										configure, expose
	-- x		horizontal position, widget relative				all mouse events
	-- y		vertical position, widget relative				all mouse events
	-- A		printing character							keypress, keyrelease
	-- B		border width								configure event
	-- E		sendevent field								all events
	-- K		key symbol									keypress, keyrelease
	-- N		key symbol in decimal							keypress, keyrelease
	-- R		root window id								all events
	-- S		subwindow id								all events
	-- T		type field									all events
	-- W		pathname of widget receiving the event			all events
	-- X		horizontal position, absolute			buttonpress, buttonrelease, keypress, keyrelease, motion
	-- Y		vertical position, absolute			buttonpress, buttonrelease, keypress, keyrelease, motion

	-- The sequence of event fields designated by the characters in event_fields_signature is grouped into a
	-- parameter list and transmitted to SETL_procedure used as callback; this must of course have
	-- the appropriate number of parameters.
	
	-- As explained above, the 'principal' event associated with each kind of widget and canvas item
	-- can also be defined using the syntax

-- 						obj{OM} := SETL_procedure;
	
	-- The basic event types supported by Tk are , , , , ,
	-- , , , , , , , , , 
	-- , , , , , , , , , . 
	-- These event designators can be qualified by prefixing the name of one or more keys or buttons which
	-- must be depressed for the event to occur, e.g.
	
	--  			 or 
	
	-- A list of letters can be used as a postfixed modifier for key event types, and a button number for
	-- button event types, e.g.   
	
	--  			 or 
	
	-- 'Bj' is allowed as a synomym of the modifier 'Buttonj', 'Button' for 'ButtonPress', and 'Key' for 'KeyPress'.
	
	-- There are also several 'virtual' event types, designating somewhat different events on different platforms. 
	-- The built-in virtual events are  <>, <>, and <>. Additional virtual events
	-- can be defined using the 'event' commnad, as explained elsewhere.

-- The 'postscript' operation available for canvases generates a postscript file allowing the canvas contents
-- to be printed. 
« March 2024 »
Su Mo Tu We Th Fr Sa
1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31
 

Powered by Plone CMS, the Open Source Content Management System

This site conforms to the following standards: