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/flexwin.icl

-implementation module flexwin
-
-/* TO DO:
-o Content look
-o Always leave first char of header string? Use clipping?
-o Polling for column widths (in order to save/restore)
-o Optimize setControlLook
-o Button functions + header & body look updates...
-o Sensible size handling
-*/
-
-import StdEnv, StdIO
-import StdDebug
-import ioutil
-
-class content_size c :: FontMetrics c -> Int
-
-:: FlexBarState s =
-	{ nrOfColumns	:: !Int
-	, columnPoss	:: ![Int]
-	, columnTexts	:: ![String]
-	, height		:: !Int
-	, windowId		:: !Id
-	, headerId		:: !Id
-	, receiverId	:: !R2Id (MessageIn s) (MessageOut s)
-	, cursep		:: !Int			// selected column seperator ~1 if none
-	, curcol		:: !Int			// selected column 0 if none negative if selected but mouse outside of button area
-
-	, domain		:: !ViewDomain
-	, info			:: !s
-	, line_height	:: !Int
-	, metrics		:: !FontMetrics
-	, columnFuncs	:: ![(FlexBarState s) -> FlexBarState s]
-	, body_look		:: !s .Int .Int [.Int] -> (.SelectState .UpdateState -> .(*Picture -> *Picture))
-	}
-
-:: MessageIn s
-	= FW_DummyIn
-	| FW_SetContent s
-	| FW_ApplyFunction Int
-	| FW_GetContent
-
-:: MessageOut s
-	= FW_DummyOut
-	| FW_ContentOut s
-
-mi2cw Nothing	= 10
-mi2cw (Just w)
-	| w < 5 = 5		// minimum column width, moet eigenlijk niet hier maar pas bij tekenen en afhankelijk van font
-	= w
-
-//--
-
-::	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)]
-
-instance Windows (FlexBarWindow s) | content_size s
-where
-	getWindowType _ = "FlexBarWindow"
-	openWindow ls (FlexBarWindow title elts info look funs receiverId atts) ps
-		# (windowId,ps) = case hasWindowIdAtt of
-							Nothing	-> openId ps
-							(Just wId) -> (wId,ps)
-		# (headerId,ps) = openId ps
-		# ((ok,font),ps) = accScreenPicture (openFont {fName="Courier New",    fStyles=[BoldStyle],fSize=8}) ps 
-		# (metrics,ps)	= accScreenPicture (getFontMetrics font) ps
-		# ((size,line_height),ps) = accScreenPicture (profileSize info o (setPenFont font)) ps
-		# domain = {zero & corner2 = {x=last columnPoss,y=height + size}}
-		= openWindow
-			(newstate info domain line_height metrics headerId windowId)
-			(Window title (header info domain line_height metrics font headerId windowId) (newatts info domain font size line_height metrics headerId windowId)) ps
-	where
-		hasWindowIdAtt
-			 # los = filter (isWindowId) atts
-			 | isEmpty los = Nothing
-			 = Just (getWindowIdAtt (hd los))
-		header info domain line_height metrics font headerId windowId
-			= CustomControl
-				{w=4096,h=height}			// zinniger maximum invullen???
-				(headerLook height columnTexts columnPoss`)
-				[ControlId headerId
-				,ControlMouse mouseFilter Able (mouseFunction (newstate info domain line_height metrics headerId windowId))
-				,ControlPos (Fix,OffsetFun 1 (\({corner1={x}},{y})->{vx = x,vy = y}))
-				,ControlPen [PenFont font]
-				]
-			:+: Receiver2 receiverId receiver []
-		newatts info domain font size line_height metrics headerId windowId = 
-			[ WindowPen [PenBack Vellum, PenFont font]
-			, WindowLook True (flexLook (newstate info domain line_height metrics headerId windowId))
-			, WindowViewDomain domain
-			, WindowId windowId
-			, WindowMouse mouseFilter Able (mouseFunction (newstate info domain line_height metrics headerId windowId))
-			, WindowKeyboard keyboardFilter Able (keyboardFunction)
-			, WindowHScroll (myScrollFunction Horizontal LR_STEP)
-			, WindowVScroll (myScrollFunction Vertical line_height)
-			, WindowClose (noLS closeProcess)
-			: fixwinatts atts
-			]
-		newstate info domain line_height metrics headerId windowId = 
-			{ nrOfColumns	= length elts
-			, columnPoss	= columnPoss
-			, columnTexts	= columnTexts
-			, height		= height
-			, metrics		= metrics
-			, line_height	= line_height
-			, windowId		= windowId
-			, headerId		= headerId
-			, receiverId	= receiverId
-			, cursep		= ~1
-			, curcol		= 0
-			, domain		= domain
-			, info			= info
-			, columnFuncs	= funs
-			, body_look		= look
-			}
-		height		= 20
-		columnPoss	= fiddle 0 (map (mi2cw o snd)  elts) []
-		columnPoss`	= [0:columnPoss]
-		columnTexts	= map fst elts
-
-appInfo :: (s->s) !(FlexBarState s) -> FlexBarState s
-appInfo f fs=:{info} = {fs & info = f info}
-
-//--
-
-LR_STEP :== 12
-
-keyboardFilter (SpecialKey key (KeyDown _) _)
-	| key == upKey		= True
-	| key == downKey	= True
-	| key == beginKey	= True
-	| key == endKey		= True
-	| key == pgUpKey	= True
-	| key == pgDownKey	= True
-	| key == leftKey	= True
-	| key == rightKey	= True
-	= False
-keyboardFilter _ = False
-
-keyboardFunction (SpecialKey key _ mods) (fs=:{windowId,height,line_height,domain,columnPoss},ps)
-	# (delta,ps) = calcDelta ps
-	| delta == zero
-		= (fs,ps)
-	# ps = appPIO (moveWindowViewFrame windowId delta) ps
-	= (fs,ps)
-where
-	calcDelta ps
-		| key == upKey
-			# (vf,ps) = accPIO (getWindowViewFrame windowId) ps
-			# delta = min (vf.corner1.y - domain.corner1.y) line_height
-			= ({zero & vy = ~delta},ps)
-		| key == downKey
-			# (vf,ps) = accPIO (getWindowViewFrame windowId) ps
-			# delta = min (domain.corner2.y - vf.corner2.y) line_height