implementation module EdWindowsMenu;

/*	The commands of the Windows menu */

import StdClass,StdBool, StdString, StdInt, StdChar, StdFile,StdArray;
import deltaEventIO, deltaWindow, deltaMenu, deltaPicture, deltaFont, deltaDialog, deltaFileSelect, deltaIOState;

import	EdProgramState, EdWindows, EdFileMenu, EdFiles, EdDialogs, EdMenuItems, EdFileMenu,
		EdPath, EdTextWindow, EdSupport, EdCleanSystem;
import UtilNewlinesFile;

(THEN) infixl;
(THEN) s f :== f s;
		
YesID			:== 1;
NoID			:== 2;
CancelID		:== 3;
    
::	InfoDef			=	{	xmax	:: !Int,
							ymax	:: !Int,
							lines	:: ![InfoLine] };
::	InfoLine		=	{	fontdef	:: InfoFontDef,
							x		:: !Int,
							y		:: !Int,
							line	:: !String };
::	InfoFontDef		=	InfoFont Font Centered | NoFont Centered;
::	Centered		:==	Bool;
::	Fonts			=	{	nft		:: !Font,
							lft		:: !Font,
							bft		:: !Font,
							dft		:: !Font,
							ift		:: !Font,
							jft		:: !Font };
::	Heights			=	{	nhgt	:: !Int,
							lhgt	:: !Int };

InfoFontName1	:== "Geneva";
InfoFontName2	:== "Helvetica";
InfoFontName3	:== "Times";
NormalSize1		:== 9;
NormalSize2		:== 12;
LargeSize1		:== 12;
LargeSize2		:== 14;
NormalStyle		:== [];
BoldStyle		:== ["Bold"];
ItalicStyle		:== ["Italic"];
Margin			:== 8;
AboutBegin		:== "\\About";
AboutEnd		:== "\\EndAbout";
HelpBegin		:== "\\Help";
HelpEnd			:== "\\EndHelp";

//
//	General AboutDialog construction.
//

MakeAboutDialog	::	!String !*Files ( ProgState -> *(IO -> ProgIO) )
					-> (DialogDef ProgState IO, *Files);
MakeAboutDialog appname files helpf
	=  IfUnixSystem
			(AboutDialog appname ((0,0),(0,0)) [] NoHelp, files`)
			(AboutDialog appname ((0,0),(xmax,ymax)) picture (AboutHelp "Help" helpf), files`);
	where {
	picture						= DrawAboutInfo fonts.nft {xmax=xmax,ymax=ymax,lines=text};
	((xmax,ymax,text),files`)	= ReadInfo msg msg fonts AboutBegin AboutEnd HelpFile files;
	fonts						= InfoFonts;
	msg							= "\\DThis is a Clean program.";
	};

InfoFonts :: Fonts;
InfoFonts = {	nft	= SelectNormalFont	NormalStyle,
				lft	= SelectLargeFont 	NormalStyle,
				bft	= SelectNormalFont	BoldStyle,
				dft	= SelectLargeFont 	BoldStyle,
				ift	= SelectNormalFont	ItalicStyle,
				jft	= SelectLargeFont	ItalicStyle };

SelectLargeFont	:: ![FontStyle] -> Font;
SelectLargeFont style
	| found1	= first;
	| found2	= second;
				= third;
	   where {
	   (found1,first )= SelectFont InfoFontName1 style LargeSize1;
	   (found2,second)= SelectFont InfoFontName2 style LargeSize2;
	   (_ ,third )= SelectFont InfoFontName3 style LargeSize2;
	   };

SelectNormalFont :: ![FontStyle] -> Font;
SelectNormalFont style
	| found1	= first;
	| found2	= second;
				= third;
	   where {
	   (found1,first )= SelectFont InfoFontName1 style NormalSize1;
	   (found2,second)= SelectFont InfoFontName2 style NormalSize2;
	   (_ ,third )= SelectFont InfoFontName3 style NormalSize2;
	   };

/*	Reading and pre-processing of the file containing the about- and help-info. */

ReadInfo :: !String !String !Fonts !String !String !String !*Files -> ((!Int,Int,![InfoLine]),!*Files);
ReadInfo msg1 msg2 fonts=:{nft,lft,bft,dft,ift,jft} begin end filename disk
	| not succes	= ((x1,y1,lines1),disk1);
	| not found		= ((x2,y2,lines2),disk`);
					= ((xm,ym,lines`),disk`);
		where {
		(_,disk`)						= fclose file` disk1;
		xm								= Margin + maxx + Margin;
		ym								= maxy + Margin - lat;
		lines`							= CenterInfoLines nft xm [] lines;
		(found,maxx,maxy,lines,file`)	= ReadInfoFile fonts heights (Margin+lat) begin end file;
		(succes,file,disk1)				= fopen (ApplicationPath filename) FReadData disk;
		(x1,y1,lines1)					= ProcessInfoString fonts msg1;
		(x2,y2,lines2)					= ProcessInfoString fonts msg2;
		heights							= {nhgt=nat + ndt + nld, lhgt=lat + ldt + lld};
		(nat,ndt,_,nld)					= FontMetrics nft;
		(lat,ldt,_,lld)					= FontMetrics lft;
		};

ProcessInfoString :: !Fonts !String -> (!Int,!Int,![InfoLine]);
ProcessInfoString fonts=:{nft,lft,bft,dft,ift,jft} line
	=  (maxx`,  maxy`, lines``);
		where {
		lines``           	= CenterInfoLines nft maxx` [] [{InfoLine | line` & x=Margin,y=Margin+lat}];
		maxx`             	= Margin + wid + Margin;
		maxy`				= 2 * Margin + hgt;
		heights				= {nhgt=nat + ndt + nld, lhgt=lat + ldt + lld};
		(nat,ndt,_,nld)		= FontMetrics nft;
		(lat,ldt,_,lld)		= FontMetrics lft;
		wid					= line`.InfoLine.x;
		hgt					= line`.InfoLine.y;
		line`				= ParseInfoLine fonts heights line;
		};

CenterInfoLines	:: !Font !Int ![InfoLine] ![InfoLine] -> [InfoLine];
CenterInfoLines nft maxx acc [info=:{fontdef=NoFont centered,x,y,line} : rest]
	| centered	= CenterInfoLines nft maxx [{InfoLine | info & x=x`} : acc] rest;
				= CenterInfoLines nft maxx [info : acc] rest;
	where {
	x`	= (maxx -  FontStringWidth line nft ) / 2;
	};
CenterInfoLines nft maxx acc [info=:{fontdef=InfoFont font centered,x,y,line} : rest]
	| centered	= CenterInfoLines nft maxx [{InfoLine | info & x=x`} : acc] rest;
				= CenterInfoLines nft maxx [info : acc] rest;
	where {
	x`	= (maxx -  FontStringWidth line font ) / 2;
	};
CenterInfoLines nft maxx acc [] = acc;

ParseInfoLine :: !Fonts !Heights !String -> InfoLine;
ParseInfoLine fonts=:{nft,lft,bft,dft,ift,jft} heights=:{nhgt,lhgt} line
	| linelen < 2 || line.[0] <> '\\'
		= {fontdef=NoFont False	, x=FontStringWidth line nft	, y=nhgt	, line=line};
		= {fontdef=infofont		, x=FontStringWidth line` font	, y=height	, line=line`};
		{
			(infofont,font,height)	= GetInfoFont_and_Height (line.[1]) fonts heights;
		}
	where {
	linelen					= size line;
	line`					= line % (2, dec linelen);
	};

GetInfoFont_and_Height	:: !Char !Fonts !Heights -> (!InfoFontDef,!Font,!Int);
GetInfoFont_and_Height 'L' {nft,lft,bft,dft,ift,jft} {nhgt,lhgt} = (InfoFont lft False, lft, lhgt);
GetInfoFont_and_Height 'b' {nft,lft,bft,dft,ift,jft} {nhgt,lhgt} = (InfoFont bft False, bft, nhgt);
GetInfoFont_and_Height 'B' {nft,lft,bft,dft,ift,jft} {nhgt,lhgt} = (InfoFont dft False, dft, lhgt);
GetInfoFont_and_Height 'i' {nft,lft,bft,dft,ift,jft} {nhgt,lhgt} = (InfoFont ift False, ift, nhgt);
GetInfoFont_and_Height 'I' {nft,lft,bft,dft,ift,jft} {nhgt,lhgt} = (InfoFont jft False, jft, lhgt);
GetInfoFont_and_Height 'c' {nft,lft,bft,dft,ift,jft} {nhgt,lhgt} = (NoFont True       , nft, nhgt);
GetInfoFont_and_Height 'C' {nft,lft,bft,dft,ift,jft} {nhgt,lhgt} = (InfoFont lft True , lft, lhgt);
GetInfoFont_and_Height 'd' {nft,lft,bft,dft,ift,jft} {nhgt,lhgt} = (InfoFont bft True , bft, nhgt);
GetInfoFont_and_Height 'D' {nft,lft,bft,dft,ift,jft} {nhgt,lhgt} = (InfoFont dft True , dft, lhgt);
GetInfoFont_and_Height 'j' {nft,lft,bft,dft,ift,jft} {nhgt,lhgt} = (InfoFont ift True , ift, nhgt);
GetInfoFont_and_Height 'J' {nft,lft,bft,dft,ift,jft} {nhgt,lhgt} = (InfoFont jft True , jft, lhgt);
GetInfoFont_and_Height chr {nft,lft,bft,dft,ift,jft} {nhgt,lhgt} = (NoFont False      , nft, nhgt);

ReadInfoFile :: !Fonts !Heights !Int !String !String !*File -> (!Bool,!Int,!Int,![InfoLine],!*File);
ReadInfoFile fonts heights maxy begin end file
	| not begin_found	=  (False,0,0,[],file1);
						=  (True,maxx,maxy`,lines,file`);
		where {
		(maxx,maxy`,lines,file`)	= ReadInfoUntil fonts heights end 0 maxy [] file1;
		(begin_found,file1)			= FindInfoBegin begin file;
		};

FindInfoBegin :: !String !*File -> (!Bool,!*File);
FindInfoBegin begin file
	| eof					= (False,file1);
	| EqualPrefix begin line	= (True,file`);
							= FindInfoBegin begin file`;
		where {
		(line,file`)= readLine file1;
		(eof,file1)	= fend file;
		};

ReadInfoUntil :: !Fonts !Heights !String !Int !Int ![InfoLine] !*File -> (!Int,!Int,![InfoLine],!*File);
ReadInfoUntil fonts heights end maxx maxy acc file
	| eof				= (maxx, maxy, acc, file1);
	| EqualPrefix end line	= (maxx, maxy, acc, file`);
						= ReadInfoUntil fonts heights end (max maxx wid) (maxy+hgt) [line`` : acc] file`;
	where {
	(line ,file`)	= readLine file1;
	(eof,file1)		= fend file;
	line`			= ParseInfoLine fonts heights (StripNewline line);
	line``			= {InfoLine | line` & x=Margin,y=maxy};
	wid				= line`.InfoLine.x;
	hgt				= line`.InfoLine.y;
	};

/*	The drawing of the about/help info. */

DrawAboutInfo :: !Font !InfoDef -> [DrawFunction];
DrawAboutInfo nft {xmax,ymax,lines} =  [SetFont nft, DrawInfo nft 0 ymax lines];

DrawInfo :: !Font !Int !Int ![InfoLine] !Picture -> Picture;
DrawInfo nft top bot [{fontdef=InfoFont font c,x,y,line} : rest] pic
	| y > bot	=  pic;
	| y < top	=  DrawInfo nft top bot rest pic;
				=  DrawInfo nft top bot rest (SetFont nft (DrawString line (SetFont font (MovePenTo (x,y) pic))));
DrawInfo nft top bot [{fontdef=NoFont c,x,y,line} : rest] pic
	| y > bot =  pic;
	| y < top =  DrawInfo nft top bot rest pic;
				= DrawInfo nft top bot rest (DrawString line (MovePenTo (x,y) pic));
DrawInfo nft top bot [] pic =  pic;

	
//
// Device Function for the Next Window command.
//
										
NextWindow :: !ProgState !IO -> ProgIO;
NextWindow prog=:{editor={editwindows=_:!otherWindows}} io
	=  SetThisWindow (next otherWindows) EmptyTSel prog io;
		where {
			next	:: !EditWindows -> EditWdId;
			next ((windowId,window):!rest)
				| window.wstate.wdtype <> ProjectWd
					= windowId;
				| otherwise
					= next rest;
			next Nil
				= NoWdID;
		};
								
//
// Device Function for the Show Clipboard command.
//

ShowClipboard :: !ProgState !IO -> ProgIO;
ShowClipboard prog io
	=  OpenClpbrdWindow prog io;

//
// Device Function for the Hide Clipboard command.
//
									
HideClipboard :: !ProgState !IO -> ProgIO;
HideClipboard prog io
	=  CloseWindow "" ClpbrdWdID prog io;

//
//	Device Function for the Help command.
//

Help :: !ProgState !IO -> ProgIO;
Help prog io = (prog,OpenWindows [window] io`);
// Help editor io =  (prog`,AlertDialog [toString xmax,toString ymax] io); // @@@
		where {
		window= FixedWindow HelpWdID (0,0) "Help"
							((0,0),(xmax,ymax)) (UpdateHelpWd fonts.nft helptext)
							[	Activate ActivateHelpWd, 
								Deactivate DeActHelpWd,
								GoAway CloseHelp ];
		(xmax,ymax,helptext,io`)	= ReadHelpInfo fonts HelpBegin HelpEnd HelpFile io;
		fonts						= InfoFonts;
		};

ReadHelpInfo :: !Fonts !String !String !String !IO -> (!Int,!Int,![InfoLine],!IO);
ReadHelpInfo fonts begin end filename io
	= (xm,ym,lines,io`);
	where {
	((xm,ym,lines),io`)	= accFiles (ReadInfo msg1 msg2 fonts begin end filename) io;
	msg1					= errpref +++ "could not be found.";
	msg2					= errpref +++ "does not contain help information.";
	errpref             	= "The help file \'" +++  filename +++ "\' " ;
	};

UpdateHelpWd :: !Font ![InfoLine] !UpdateArea !ProgState -> (!ProgState, ![DrawFunction]);
UpdateHelpWd nft lines areas s =  (s, [SetFont nft, RedrawAreas nft lines areas]);

RedrawAreas	:: !Font ![InfoLine] !UpdateArea !Picture -> Picture;
RedrawAreas nft lines [area=:((l,t),(r,b)) : rest] pict
	=  RedrawAreas nft lines rest (DrawInfo nft (dec t) (b + 40) lines pict);
RedrawAreas nft lines [] pict =  pict;

ActivateHelpWd :: !ProgState !IO -> ProgIO;
ActivateHelpWd prog io =  (prog, io`);
	where {
		io`= io	THEN EnableMenuItems  [ICloseID]
				THEN DisableMenuItems [ISaveID,ISavesID,IReverID]
				THEN ChangeMenuItemFunctions [(ICloseID,CloseHelp)];
	};

DeActHelpWd	:: !ProgState !IO -> ProgIO;
DeActHelpWd prog io =  (prog,io);

CloseHelp :: !ProgState !IO -> ProgIO;
CloseHelp prog io
	| windows	= (prog, EnableMenuItems [ISavesID] io2);
				= (prog, DisableMenuItems [ICloseID] io2);
	where {
		io2= ChangeMenuItemFunctions [(ICloseID,Close)] io1;
		(windows,_,io1)= GetActiveWindow (CloseWindows [HelpWdID] io);
	};

//
//	Device function for the Save All command
//

SaveAll :: !ProgState !IO -> ProgIO;
SaveAll prog io = prio`;
	where {
	(prio`, _)	= SaveTheWindows False "" prog io;
	};
	
//
//	Function to check whether all edit windows must be saved
//

SaveTheWindows :: !Bool !String !ProgState !IO -> (!ProgIO, !Bool);
SaveTheWindows alert alertmsg prog=:{editor={editwindows}} io
	= DoSaveAll alert alertmsg wdids prog io;
	where {
	wdids	= GetUsedWdIds editwindows;
	};

DoSaveAll :: !Bool !String !(List EditWdId) !ProgState !IO -> (!ProgIO, !Bool);
DoSaveAll alert alertmsg Nil prog io = ((prog,io), True);
DoSaveAll alert alertmsg (id:!rest) prog=:{editor={editwindows}} io
	| saved		= DoSaveAll alert alertmsg rest prog io;
	| yes		= DoSaveAll alert alertmsg rest prog` io`;
	| no		= DoSaveAll alert alertmsg rest prog2 io1;
				= ((prog2,io1), False);
where {
	saved				=  window.wstate.saved || window.wstate.wdtype <> EditWd ;
	yes					=  butid == YesID;
	(butid,prog2, io1)  =  butid_io1;
	butid_io1           =  case alert of {
								True  -> OpenNotice notice prog io;
								other -> (YesID, prog, io);
						   };
	(prog`,io`)			=  DoSave id window prog2 io1;
	window				=  GetWindow id editwindows;
	no					=  butid == NoID;
	notice				=  Notice [line1,line2] yesbut [nobut,cancelbut];
	line1				=  "Save changes to \"" +++  name +++ "\"" ;
	line2				=  "before " +++  alertmsg +++ "?";
	name				=  RemovePath window.wstate.pathname;
	yesbut				=  NoticeButton YesID "Yes";
	nobut				=  NoticeButton NoID "No";
	cancelbut			=  NoticeButton CancelID "Cancel";
};



DoSave :: !EditWdId !EditWindow !ProgState !IO -> ProgIO;
DoSave id window=:{wstate={pathname}} prog=:{editor=ed=:{editwindows}} io
	| GetModuleName pathname  == "Untitled"	= DoSaveAs id window prog` io`;
	| good									= Saved_UpdateMenuItems pathname prog` io`;
											= AlertDialog [ "The file \"" +++  RemovePath pathname  +++ "\" could not be saved" ,
						                      "because of an I/O error."] prog io`;
	where {
	prog`			= {prog & editor={ed & editwindows=editwindows`}};
	(good,io`)	= accFiles (SaveFile pathname window.wformat.WinFormat.newlines text) io;
	editwindows`	= SetWindow id {window` & wstate={window`.wstate & saved=True}} editwindows;
	(window`,_,text)= GetText window;
	};

DoSaveAs :: !EditWdId !EditWindow !ProgState !IO -> ProgIO;
DoSaveAs id oldwd=:{wstate={pathname=oldpath}} prog io
	# (save,path,prog,io)
		=  EdSelectOutputFile "Saves As:" (RemovePath oldpath) prog io;
	| not save
		=	(prog,io);
	| GetModuleName (RemovePath path)  == HelpFile
		=	HelpFileAlert prog io;
	# (oldwd`,_,text)			=  GetText oldwd; 
	  window					=  {oldwd` & wstate = {oldwd`.wstate & saved=True, pathname=path}};
	  (good,io)
		=	accFiles (SaveFile path oldwd`.wformat.WinFormat.newlines text) io;
	| not good
		=	AlertDialog [	"The file could not be saved because",
		                      				"of a file I/O error."] prog io;
	// otherwise
		#	(editwindows,prog)
				=	prog!editor.editwindows;
			editwindows
				=	SetWindow id window editwindows;
		=	Saved_UpdateMenuItems oldpath {prog & editor.editwindows=editwindows} io;

//
//	Device function for the Close All command
// 

CloseAll :: !ProgState !IO -> ProgIO;
CloseAll prog=:{editor={Editor | project}} io
	= DoCloseAll present (-1) prog (CloseWindows [HelpWdID] io);
	where {
	present	= PR_ProjectSet project;
	};

/* Close the current project, if any, first so it isn't affected by closing other windows */

DoCloseAll :: !Bool !EditWdId !ProgState !IO -> ProgIO;
DoCloseAll present id prog io
	| present					= DoCloseAll False id proga ioa;
	| not windows || id == wdid	= (prog, io1);
								= DoCloseAll False wdid progb iob;
	where {
	(windows,wdid,io1)	= GetActiveWindow io;
// RWS ... hackerdiekhack	(proga,ioa)			= CloseWindow "closing" ProjectWdID prog io;
	(proga,ioa) = (prog, io);
// ... RWS
	(progb,iob)			= CloseWindow "closing" wdid prog io1;
	};

/*	Misc. function(s) */

EqualPrefix	:: !String !String -> Bool;
EqualPrefix prefix string
	| prefixlen >  size string	= False;
							= prefix ==  string % (0, dec prefixlen) ;
		where {
		prefixlen= size prefix;
		};

StripNewline :: !String -> String;
StripNewline ""     =  "";
StripNewline string
	|  string.[last]  <> '\n'	=  string;
								= string % (0, dec last);
		where {
		last= dec (size string);
		};
