no message

BatchBuild.prj

@@ -39,12 +39,13 @@ Global
 	Paths
 		Path:	{Project}
 		Path:	{Project}\BatchBuild
-		Path:	{Application}\Directory
-		Path:	{Application}\ArgEnvWindows
 		Path:	{Project}\Pm
 		Path:	{Project}\Util
 		Path:	{Project}\Win
 		Path:	{Project}\Interfaces\LinkerInterface
+		Path:	{Project}\Win\PatchConsoleEvents
+		Path:	{Project}\Win\ArgEnvWindows
+		Path:	{Project}\Win\Directory
 	Precompile:	
 	Postlink:	
 MainModule

BatchBuild/IdeState.dcl

@@ -3,12 +3,12 @@ definition module IdeState
 import StdPSt, StdId, StdPictureDef
 import StdPathname
 import UtilStrictLists
-from PmAbcMagic import ABCCache
-from PmProject import Project
+from PmAbcMagic import :: ABCCache
+from PmProject import :: Project
 import PmCompilerOptions
 import typewin
 import PmEnvironment
-from PmFileInfo import FileInfoCache
+from PmFileInfo import :: FileInfoCache
 
 :: *General
 
@@ -58,6 +58,7 @@ getCurrentObjts :: !*(PSt *General) -> (!(List String),!*PSt *General)
 getCurrentComp :: !*(PSt *General) -> (!String,!*PSt *General)
 getCurrentCgen :: !*(PSt *General) -> (!String,!*PSt *General)
 getCurrentLink :: !*(PSt *General) -> (!String,!*PSt *General)
+getCurrentDynl :: !*(PSt *General) -> (!String,!*PSt *General)
 getCurrentVers :: !*(PSt *General) -> (!Int,!*PSt *General)
 getCurrentMeth :: !*(PSt *General) -> (!CompileMethod,!*PSt *General)
 

BatchBuild/IdeState.icl

@@ -3,14 +3,13 @@ implementation module IdeState
 import StdPSt, StdId, StdPictureDef, StdMisc, StdList, StdProcess, StdPStClass
 import StdPathname
 import UtilStrictLists
-from PmAbcMagic import ABCCache, AC_Init
-from PmProject import Project, PR_GetTarget
+from PmAbcMagic import :: ABCCache, AC_Init
+from PmProject import :: Project, PR_GetTarget
 import PmCompilerOptions
 import typewin
 import PmEnvironment
 import logfile
 import set_return_code
-//import PmDriver
 import PmFileInfo
 
 :: *General =
@@ -160,6 +159,11 @@ getCurrentLink ps
 	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
 	= (ct.target_link,ps)
 
+getCurrentDynl :: !*(PSt *General) -> (!String,!*PSt *General)
+getCurrentDynl ps
+	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps
+	= (ct.target_dynl,ps)
+
 getCurrentVers :: !*(PSt *General) -> (!Int,!*PSt *General)
 getCurrentVers ps
 	# (ct,ps) = accPLoc (\p=:{pm_targets,pm_curtarg}->(pm_targets!!pm_curtarg,p)) ps

BatchBuild/messwin.dcl

 definition module messwin
 
 import StdString, StdPSt
-from IdeState import General
+from IdeState import :: General
 
 :: Info
 	= Level1 String

BatchBuild/messwin.icl

 implementation module messwin
 
 import StdString, StdPSt, StdBool, StdList, StdFunc
-from IdeState import General, writeLog
+from IdeState import :: General, writeLog
 
 :: Info
 	= Level1 String

Editor/EdClient.dcl

 definition module EdClient
 
 import EdMonad, EdState, EdCommon
-from EdMessage import EditAction
+from EdMessage import :: EditAction
 
 sendToActiveWindow :: .(*(EditState,*PSt *b) -> *(.c,*(EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b
 

Editor/EdCommon.dcl

 definition module EdCommon
 
-from StdPSt		import PSt, IOSt
-from EdState	import Editor, EditorState
-from EdMonad	import EditMonad, StateM, EditState
-from EdSelection	import Selection, Position, ColumnNr, LineNr
+from StdPSt			import :: PSt
+from EdState		import class Editor, :: EditorState
+from EdMonad		import :: EditMonad, :: StateM, :: EditState
+from EdSelection	import :: Selection, :: Position
 
 :: *PLocState :== MyEditorState
 :: MyEditorState = MES EditorState

Editor/EdCommon.icl

 implementation module EdCommon
 
-from EdState import Editor, EditorState
+from EdState import class Editor, :: EditorState
 import EdMonad
 
 :: *PLocState :== MyEditorState

Editor/EdEditMenu.dcl

@@ -4,9 +4,8 @@
 
 definition module EdEditMenu
 
-from StdMenu	import Menu, Title, MenuAttribute
-from StdPSt		import PSt, IOSt
-from EdCommon	import MyEditorState
+from StdPSt		import :: PSt
+from EdCommon	import :: MyEditorState
 
 openEditMenu :: (PSt *MyEditorState) -> PSt *MyEditorState
 

Editor/EdFileMenu.dcl

@@ -4,11 +4,9 @@
 
 definition module EdFileMenu
 
-from StdMenu	import Menu, Title, MenuAttribute
-from StdId		import Id
-from StdPSt		import PSt, IOSt
-from EdState	import EditorState
-from EdCommon	import MyEditorState
+from StdId		import :: Id
+from StdPSt		import :: PSt
+from EdCommon	import :: MyEditorState
 
 openFileMenu :: Id (PSt *MyEditorState) -> PSt *MyEditorState
 

Editor/EdOptionsMenu.dcl

@@ -4,9 +4,8 @@
 
 definition module EdOptionsMenu
 
-from StdMenu	import Menu, Title, MenuAttribute
-from StdPSt		import PSt, IOSt
-from EdCommon	import MyEditorState
+from StdPSt		import :: PSt
+from EdCommon	import :: MyEditorState
 
 openOptionsMenu :: !(PSt *MyEditorState) -> PSt *MyEditorState
 

HeapProfile/ExtNotice.dcl

-definition module ExtNotice
-
-/*
-0.0 [P88] The original notice class from the Object IO tutorial
-1.0 [DvA] Modified for use with the new Clean IDE
-2.0 [DvA] Added TimedNotice class
-
-P88 = Peter Achten (peter88@cs.kun.nl)
-DvA = Diederik van Arkel (diederik@cs.kun.nl)
-*/
-
-import StdWindow, StdTimerDef
-
-:: Notice ls ps
-	= Notice [String] (NoticeButton *(ls,ps)) [NoticeButton *(ls,ps)]
-
-:: NoticeButton ps
-	= NoticeButton String (IdFun ps)
-
-instance Dialogs Notice
-
-openNotice :: !(Notice .ls *(PSt .l)) !*(PSt .l) -> *PSt .l
-
-okNotice text ps :== openNotice (Notice text (NoticeButton "OK" (\x->x)) []) ps
-
-:: TimedNotice ls ps
-	= TimedNotice [String] TimerInterval (NoticeButton *(ls,ps)) [NoticeButton *(ls,ps)]
-
-instance Dialogs TimedNotice
-
-openTimedNotice :: !(TimedNotice .ls *(PSt .l)) !*(PSt .l) -> *PSt .l
-
-okTimedNotice text time ps :== openTimedNotice (TimedNotice text time (NoticeButton "OK" (\x->x)) []) ps

HeapProfile/ExtNotice.icl

-implementation module ExtNotice
-
-import StdTuple, StdMisc, StdFunc
-import StdId, StdPSt, StdWindow, StdTimer
-
-:: Notice ls ps
-	= Notice [String] (NoticeButton *(ls,ps)) [NoticeButton *(ls,ps)]
-
-:: NoticeButton ps
-	= NoticeButton String (IdFun ps)
-
-instance Dialogs Notice
-where
-//	openDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
-	openDialog ls notice ps
-		#	(wId, ps)	= accPIO openId ps
-			(okId,ps)	= accPIO openId ps
-		=	openDialog ls (noticeToDialog wId okId notice) ps
-	
-//	openModalDialog :: .ls (Notice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
-	openModalDialog ls notice ps
-		#	(wId, ps)	= accPIO openId ps
-			(okId,ps)	= accPIO openId ps
-		=	openModalDialog ls (noticeToDialog wId okId notice) ps
-	
-//	getDialogType :: (Notice .ls .ps) -> WindowType
-	getDialogType _
-		= "Notice"
-
-openNotice :: !(Notice .ls *(PSt .l)) !*(PSt .l) -> *PSt .l
-openNotice notice ps
-	= snd (openModalDialog undef notice ps)
-
-//noticeToDialog :: Id Id !(Notice .ls (PSt .l)) -> Dialog
-noticeToDialog wid okid (Notice texts ok buttons)
-	= Dialog "" (texts` :+: ok` :+: buttons`)
-		[ WindowId wid
-		, WindowOk okid
-		]
-where
-	texts`		= LayoutControl
-					( ListLS
-						[ TextControl text [ControlPos (Left,zero)]
-						\\ text <- texts
-						]
-					)
-					[ ControlHMargin 0 0
-					, ControlVMargin 0 0
-					, ControlItemSpace 3 3
-					]
-	ok`			= noticebutton ok [ControlPos (Right,zero), ControlId okid]
-	buttons`	= ListLS
-					[ noticebutton button [ControlPos (LeftOfPrev,zero)]
-					\\ button <- buttons
-					]
-	noticebutton (NoticeButton text f) atts
-		= ButtonControl text [ControlFunction f`:atts]
-	where
-		f` (ls,ps) = f (ls,closeWindow wid ps)
-
-okNotice text ps :== openNotice (Notice text (NoticeButton "OK" (\x->x)) []) ps
-
-:: TimedNotice ls ps
-	= TimedNotice [String] TimerInterval (NoticeButton *(ls,ps)) [NoticeButton *(ls,ps)]
-
-instance Dialogs TimedNotice
-where
-//	openDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!ErrorReport, !PSt .l)
-	openDialog ls notice ps
-		#	(wId, ps)	= accPIO openId ps
-			(okId,ps)	= accPIO openId ps
-		=	openDialog ls (timednoticeToDialog wId okId notice) ps
-	
-//	openModalDialog :: .ls (TimedNotice .ls (PSt .l)) (PSt .l) -> (!(!ErrorReport,!Maybe .ls),!PSt .l)
-	openModalDialog ls notice ps
-		#	(wId, ps)	= accPIO openId ps
-			(okId,ps)	= accPIO openId ps
-		=	openModalDialog ls (timednoticeToDialog wId okId notice) ps
-	
-//	getDialogType :: (TimedNotice .ls .ps) -> WindowType
-	getDialogType _
-		= "TimerNotice"
-
-openTimedNotice :: !(TimedNotice .ls *(PSt .l)) !*(PSt .l) -> *PSt .l
-openTimedNotice notice ps
-	= snd (openModalDialog undef notice ps)
-
-//timednoticeToDialog :: Id Id !(TimedNotice .ls (PSt .l)) -> Dialog
-timednoticeToDialog wid okid (TimedNotice texts time ok buttons)
-	= Dialog "" (texts` :+: ok` :+: buttons`)
-		[ WindowId wid
-		, WindowOk okid
-		, WindowInit (noLS timestuff)
-		]
-where
-	timestuff ps
-		# (err,ps) = openTimer undef timer` ps
-		| err <> NoError 
-			# ps = okNotice ["Timer Creation Failed"] ps
-			# ps = closeWindow wid ps
-			= ps
-		= ps
-	texts`		= LayoutControl
-					( ListLS
-						[ TextControl text [ControlPos (Left,zero)]
-						\\ text <- texts
-						]
-					)
-					[ ControlHMargin 0 0
-					, ControlVMargin 0 0
-					, ControlItemSpace 3 3
-					]
-	ok`			= noticebutton ok [ControlPos (Right,zero), ControlId okid]
-	buttons`	= ListLS
-					[ noticebutton button [ControlPos (LeftOfPrev,zero)]
-					\\ button <- buttons
-					]
-	timer` = Timer time NilLS [TimerFunction (\_ (ls,ps)->(ls,closeWindow wid ps))]
-	noticebutton (NoticeButton text f) atts
-		= ButtonControl text [ControlFunction f`:atts]
-	where
-		f` (ls,ps) = f (ls,closeWindow wid ps)
-
-okTimedNotice text time ps :== openTimedNotice (TimedNotice text time (NoticeButton "OK" (\x->x)) []) ps
-

HeapProfile/expand_8_3_names_in_path.dcl

-definition module expand_8_3_names_in_path;
-
-expand_8_3_names_in_path :: !{#Char} -> {#Char};

HeapProfile/expand_8_3_names_in_path.icl

-implementation module expand_8_3_names_in_path;
-
-import StdEnv;
-
-FindFirstFile :: !String -> (!Int,!String);
-FindFirstFile file_name
-	# find_data = createArray 318 '\0';
-	# handle = FindFirstFile_ file_name find_data;
-	= (handle,find_data);
-
-FindFirstFile_ :: !String !String -> Int;
-FindFirstFile_ file_name find_data
-	= code {
-		ccall FindFirstFileA@8 "Pss:I"
-	}
-
-FindClose :: !Int -> Int;
-FindClose handle = code {
-		ccall FindClose@4 "PI:I"
-	}
-
-find_null_char_in_string :: !Int !String -> Int;
-find_null_char_in_string i s
-	| i<size s && s.[i]<>'\0'
-		= find_null_char_in_string (i+1) s;
-		= i;
-
-find_data_file_name find_data
-	# i = find_null_char_in_string 44 find_data;
-	= find_data % (44,i-1);
-
-find_first_file_and_close :: !String -> (!Bool,!String);
-find_first_file_and_close file_name
-	# (handle,find_data) = FindFirstFile file_name;
-	| handle <> (-1)
-		# r = FindClose handle;
-		| r==r
-			= (True,find_data);
-			= (False,find_data);
-		= (False,"");
-
-find_last_backslash_in_string i s
-	| i<0
-		= (False,-1);
-	| s.[i]=='\\'
-		= (True,i);
-		= find_last_backslash_in_string (i-1) s;
-
-expand_8_3_names_in_path :: !{#Char} -> {#Char};
-expand_8_3_names_in_path path_and_file_name
-	# (found_backslash,back_slash_index) = find_last_backslash_in_string (size path_and_file_name-1) path_and_file_name;
-	| not found_backslash
-		= path_and_file_name;
-	# path = expand_8_3_names_in_path (path_and_file_name % (0,back_slash_index-1));
-	# file_name = path_and_file_name % (back_slash_index+1,size path_and_file_name-1);
-	# path_and_file_name = path+++"\\"+++file_name;
-	# (ok,find_data) = find_first_file_and_close (path_and_file_name+++"\0");
-	| ok
-		= path+++"\\"+++find_data_file_name find_data;
-		= path_and_file_name;

HeapProfile/flexwin.dcl

-definition module flexwin
-
-import StdEnv, StdIO
-//import ShowProfile
-
-//::	FlexBarWindow ls pst = FlexBarWindow Title [(String, Maybe Int)] [WindowAttribute *(ls,pst)]
-//::	FlexBarWindow ls pst
-//	= FlexBarWindow Title [(String, Maybe Int)] .[FormattedProfile] (R2Id (MessageIn ls) MessageOut) [WindowAttribute *(ls,pst)]
-//::	FlexBarWindow s ls pst
-//	= FlexBarWindow Title [(String, Maybe Int)] [s] (R2Id (MessageIn s) MessageOut) [WindowAttribute *(ls,pst)]
-
-class content_size c :: FontMetrics c -> Int
-
-::FlexBarState s
-::	FlexBarWindow s ls pst
-	= FlexBarWindow Title [(String, Maybe Int)] s
-		(!s .Int .Int [.Int] -> (.SelectState .UpdateState -> .(*Picture -> *Picture)))
-		![(FlexBarState s) -> FlexBarState s]
-		(R2Id (MessageIn s) (MessageOut s)) [WindowAttribute *(ls,pst)]
-
-:: MessageIn s
-	= FW_DummyIn
-	| FW_SetContent s		//[.FormattedProfile]
-	| FW_ApplyFunction Int
-	| FW_GetContent
-
-:: MessageOut s
-	= FW_DummyOut
-	| FW_ContentOut s
-
-instance Windows (FlexBarWindow s) | content_size s
-
-//--
-
-appInfo :: (s->s) !(FlexBarState s) -> FlexBarState s

HeapProfile/handler.dcl

-definition module handler;
-
-import deltaDialog, deltaIOState;
-//import intrface, clCrossCall,ioTypes;
-
-InstallDDEHandler :: (String *s -> *((IOState *s) -> (*s, IOState *s))) *s (IOState *s)
-                             -> (*s, IOState *s);
\ No newline at end of file

HeapProfile/handler.icl

-implementation module handler;
-
-import deltaDialog, deltaIOState;
-import intrface, clCrossCall,ioTypes;
-
-InstallDDEHandler :: (String *s -> *((IOState *s) -> (*s, IOState *s))) *s (IOState *s)
-                             -> (*s, IOState *s);
-InstallDDEHandler funct s iostate = (s,iostate`);
-where
-{   (adm, os) = UnpackIOStateWithCheck iostate;
-    adm`      = { adm & io_ddehandler = funct };
-    iostate`  = PackIOState adm` os;
-}

HeapProfile/ioutil.dcl

-definition module ioutil
-
-import StdOverloaded, StdBool, StdList
-import StdPicture, StdPSt, StdId, StdIOCommon, StdFile
-from commondef import unzip3,unzip4
-
-//getParentWindowId :: !Id !(IOSt .l) -> (!Maybe Id, !IOSt .l)
-
-safeOpenFixedFont :: !.FontDef !*Picture -> (Font,*Picture);
-
-instance toString FontDef
-instance accScreenPicture (PSt .l)
-//instance Ids (PSt .l .p)
-instance FileEnv Files
-
-filterReturnKeys :: KeyboardStateFilter
-escFilter :: KeyboardStateFilter
-toMark :: !Bool -> MarkState
-toSelect :: !Bool -> SelectState
-noPS :: .(.a -> .b) !(.a,.c) -> (.b,.c)
-drawLeft :: !.Point2 a !*Picture -> *Picture | toString a
-drawCenter :: !.Point2 a !*Picture -> *Picture | toString a
-drawRight :: !.Point2 a !*Picture -> *Picture | toString a
-setCheckControlItem :: !Id .Index !.Bool !*(IOSt .a) -> *IOSt .a;
-zip3::![.a] [.b] [.c] -> [(.a,.b,.c)]
-//unzip3 ::![(.a,.b,.c)] -> ([.a],[.b],[.c]) // now in ObjectIO/commondef
-getPenAttributeFont :: ![.PenAttribute] -> FontDef;
-getPenAttributeColour :: ![.PenAttribute] -> Colour;
-getPenAttributeBack :: ![.PenAttribute] -> Colour;
-seqmap :: (.a -> .(.b -> .b)) ![.a] !.b -> .b;
-notEmpty s		:== not (isEmpty s)

HeapProfile/ioutil.icl

-implementation module ioutil
-
-//import StdEnv, StdIO
-
-import StdBool,StdList,StdFile
-import StdControl,StdPSt
-import iostate
-/* zit nu in StdControl mar nog niet geexporteerd
-getParentWindowId :: !Id !(IOSt .l) -> (!Maybe Id, !IOSt .l)
-getParentWindowId controlId ioState
-	# (idtable,ioState)	= IOStGetIdTable ioState
-	  maybeParent		= getIdParent controlId idtable
-	| isNothing maybeParent
-		= (Nothing,ioState)
-	# parent			= fromJust maybeParent
-	# (ioId,ioState)	= IOStGetIOId ioState
-	| ioId==parent.idpIOId && parent.idpDevice==WindowDevice
-		= (Just parent.idpId,ioState)
-	| otherwise
-		= (Nothing,ioState)
-*/
-safeOpenFixedFont :: !.FontDef !*Picture -> (Font,*Picture);
-safeOpenFixedFont fdef pict
-	# ((ok,fnt),pict) = openFont fdef pict
-	# ((ok,fnt),pict) = case ok of
-							True -> ((ok,fnt),pict)
-							False -> openFont fdef` pict
-	| not ok
-		= openDefaultFont pict
-	= (fnt,pict)
-where
-	fdef` = NonProportionalFontDef
-	
-instance toString FontDef
-where
-	toString {fName,fSize,fStyles} = "<fName: "+++fName+++",fSize: "+++toString fSize+++",fStyles: "+++toS fStyles+++ ">"
-	where
-		toS [] = ""
-		toS [s] = s
-		toS [h:t] = h+++", "+++toS t
-
-filterReturnKeys :: KeyboardStateFilter
-filterReturnKeys = filterfun
-where
-	filterfun (SpecialKey key  (KeyDown False) _)	= key==enterKey
-	filterfun (CharKey    '\n' (KeyDown False))		= True
-	filterfun _										= False
-
-escFilter :: KeyboardStateFilter
-escFilter = filter
-where
-	filter (SpecialKey key KeyUp mods) = (key == escapeKey) && (mods == NoModifiers)
-	filter _ = False
-
-instance accScreenPicture (PSt .l)
-where
-	accScreenPicture f ps = accPIO (accScreenPicture f) ps
-/*
-instance Ids (PSt .l .p)
-where
-	openId ps = accPIO openId ps
-	openIds	n ps = accPIO (openIds n) ps
-	
-	openRId ps = accPIO openRId ps
-	openRIds	n ps = accPIO (openRIds n) ps
-	
-	openR2Id ps = accPIO openR2Id ps
-	openR2Ids	n ps = accPIO (openR2Ids n) ps
-*/
-toMark :: !Bool -> MarkState
-toMark True = Mark
-toMark False = NoMark
-
-toSelect :: !Bool -> SelectState
-toSelect True = Able
-toSelect False = Unable
-
-noPS :: .(.a -> .b) !(.a,.c) -> (.b,.c)
-noPS f (ls,ps) = (f ls,ps)
-
-drawLeft :: !.Point2 a !*Picture -> *Picture | toString a
-drawLeft point info picture
-	#	text				= toString info
-	=	drawAt point text picture
-
-drawCenter :: !.Point2 a !*Picture -> *Picture | toString a
-drawCenter {x,y} info picture
-	#	text				= toString info
-		(width,picture)		= getPenFontStringWidth text picture
-	=	drawAt {x=x-width/2,y=y} text picture
-
-drawRight :: !.Point2 a !*Picture -> *Picture | toString a
-drawRight {x,y} info picture
-	#	text				= toString info
-		(width,picture)		= getPenFontStringWidth text picture
-	=	drawAt {x=x-width,y=y} text picture
-
-setCheckControlItem :: !Id .Index !.Bool !*(IOSt .a) -> *IOSt .a
-setCheckControlItem id idx True io = markCheckControlItems id [idx] io
-setCheckControlItem id idx False io = unmarkCheckControlItems id [idx] io
-
-zip3::![.a] [.b] [.c] -> [(.a,.b,.c)]
-zip3 [a:as] [b:bs] [c:cs]	= [(a,b,c):zip3 as bs cs]
-zip3 as bs cs				= []
-
-getPenAttributeFont :: ![.PenAttribute] -> FontDef;
-getPenAttributeFont [] = SansSerifFontDef
-getPenAttributeFont [PenFont f:_] = getFontDef f
-getPenAttributeFont [_:t] = getPenAttributeFont t
-
-getPenAttributeColour :: ![.PenAttribute] -> Colour;
-getPenAttributeColour [] = Black
-getPenAttributeColour [PenColour c:_] = c
-getPenAttributeColour [_:r] = getPenAttributeColour r
-
-getPenAttributeBack :: ![.PenAttribute] -> Colour;
-getPenAttributeBack [] = White
-getPenAttributeBack [PenBack c:_] = c
-getPenAttributeBack [_:r] = getPenAttributeBack r
-
-instance FileEnv Files
-where