platform abstraction

Ed/EdMonad.icl

@@ -8,6 +8,9 @@ import UtilNewlinesFile, StateMonad
 import StdId
 import EdVisualText, EdSelection, EdLook
 import EdAction
+import Platform
+//import dodebug
+trace_n` _ s :== s
 
 :: ActionInfo
 	= NoInfo
@@ -476,13 +479,28 @@ setNeedSave need =
 	getEditState											>>>= \{windowId,pathName} ->
 	accEnv (accPIO (getWindowTitle windowId))				>>>= \oldTitle ->
 	let
-		windowName = (if readOnly pathNameToWindowTitle` pathNameToWindowTitle) pathName
-		windowTitle = if need ("*"+++windowName) windowName
+		windowName	= (if readOnly pathNameToWindowTitle` pathNameToWindowTitle) pathName
+		windowTitle	= PlatformDependant
+						/*Win*/	(if need ("*"+++windowName) windowName)
+						/*Mac*/ windowName
 	in
+
 	IF (needsetwin oldTitle windowTitle)
 	THEN
 	(
-	appEnv (appPIO (setWindowTitle windowId windowTitle) )	>>>
+		appEnv (appPIO (setWindowTitle windowId windowTitle))
+	)
+	ELSE
+	(
+		skip
+	)	>>>
+
+	accEnv (accPIO (getWindowModified windowId))			>>>= \wasModified ->
+	IF (isJust wasModified && fromJust wasModified <> need)
+
+	THEN
+	(
+	appEnv (appPIO (setWindowModified windowId windowName need))		>>>
 	updateEditState update
 	)
 	ELSE
@@ -575,3 +593,4 @@ where
 	selectMode	= state.mod
 	virtualX	= state.vix
 	visible		= state.vis
+

Ed/syncol.dcl

@@ -10,8 +10,8 @@ import StrictList
 //	,!Bool		// in typedef at start of line
 	,!Bool		// is typedef line
 //	,!Bool		// in typedecl at start of line
-//	,!Int		// typedecl offside level
 	,!Bool		// is typedecl line
+	,!Int		// context offside level
 	)
 // pack bools into bitfield?
 

Ed/syncol.icl

@@ -25,6 +25,10 @@ where
 	line4	= " -> fraps"
 	line5	= "global :== something"
 */
+
+
+
+
 /*
 	parseLine: initial comment nesting level & textline -> new comment nesting level
 */
@@ -204,6 +208,10 @@ where
 WhiteSpace c
 :==	c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '\f';
 
+//slFromList` :: ![a] -> StrictList a
+slFromList` [] r = r
+slFromList` [x:xs] r = SCons x (slFromList` xs r)
+
 /*
 	firstParse: textlines -> zip initial comment nesting level & textlines
 */
@@ -240,5 +248,88 @@ where
 
 quickParse :: !Int !Int !(StrictList (!Info,!String)) -> (Int,Int,StrictList (!Info,!String))
 quickParse fln lln text
-	= (0,slLength text - 1,firstParse (slMap (\(_,s)->s) text))
+	# (beg,end,res)	= parseBefore 0 (-1,0,False,False,0) id [] text
+	# res	= trace_n` ("quickParse",beg,end,fln,lln) res
+	# beg = if (beg < 0) (trace_n` "FIX BEGIN" 0) beg
+	# end = if (end >= slLength res) (trace_n` "FIX END" slLength res - 1) end
+	= (beg,end,res)
+where
+	join [] l = l
+	join [h:t] l = SCons h (join t l)
+
+	parseBefore :: !Int !(!Int,!Int,!Bool,!Bool,!Int) !((StrictList (!Info,!String)) -> StrictList (!Info,!String)) ![(!(!Int,!Bool,!Bool,!Int),!String)] !(StrictList (!Info,!String)) -> (!Int,!Int,!StrictList (!Info,!String))
+	parseBefore cln (begin,lev,def,tdec,off) res acc rest=:SNil
+		= (dec cln,dec cln,res (slFromList acc))
+	parseBefore cln s=:(begin,lev,def,tdec,off) res acc rest=:(SCons h=:((lev`,def`,dec`,off`),l) t)
+		| cln >= fln
+			= parseDuring begin begin (lev,def,tdec,off) res [] (join acc rest)
+		# line_size				= size l
+		# (index,off``,_)		= scanFirst lev` 0 0 l
+		# non_empty				= off`` >= 0 && index < line_size
+		# not_double_colon		= l%(index,dec (scanfunny index line_size l)) <> "::"
+		# has_content			= non_empty && if (index > 0) not_double_colon True
+		| trace_n` ("parseBefore",cln,has_content,s,h) False = undef
+		| not dec` && has_content
+			// flush acc &  continue...
+			= parseBefore (inc cln) (cln,lev`,def`,dec`,off``) (\r -> res (slFromList` acc r)) [h] t
+			= parseBefore (inc cln) (begin,lev,def,tdec,off) res (acc ++ [h]) t
+
+	parseDuring :: !Int !Int !(!Int,!Bool,!Bool,!Int) !((StrictList (!Info,!String)) -> StrictList (!Info,!String)) ![(!(!Int,!Bool,!Bool,!Int),!String)] !(StrictList (!Info,!String)) -> (!Int,!Int,!StrictList (!Info,!String))
+	parseDuring cln begin (lev,def,tdec,off) res acc SNil
+		= (begin,dec cln,res (slFromList acc))
+	parseDuring cln begin i=:(lev,def,dec,off) res acc rest=:(SCons h=:(_,l) t)
+		| cln > lln
+			= parseAfter cln begin i res acc rest
+		| trace_n` ("parseDuring",cln,i,h) False = undef
+		#! (has_contents,j=:(level`,def`,dec`,off`)) = parseLine i l
+		   new = (lev,def`,dec`,off`)
+		| dec == False && dec` && off < off`
+			| has_contents
+				= parseDuring (inc cln) begin j (\r -> res (slFromList` acc r)) [(new,l)] t							//@@@@
+			// should be identifier in acc...
+			#!	j` = (lev,def,dec`,off)
+				acc = [fix s \\ s<- acc]
+				res = (\r -> res (slFromList` acc r))
+			= parseDuring cln begin j` res [] rest					//@@@@
+		| has_contents
+			#!	res = (\r -> res (slFromList` acc r))
+			= parseDuring (inc cln) begin j res [(new,l)] t								//@@@@
+		#!	acc = acc ++ [(new,l)]
+		= parseDuring (inc cln) begin j res acc t
+	where
+		fix :: !(!Info,!String) -> (!Info,!String)
+		fix ((c,t,d,o),l) = ((c,False,True,o),l)
+
+	parseAfter :: !Int !Int !(!Int,!Bool,!Bool,!Int) !((StrictList (!Info,!String)) -> StrictList (!Info,!String)) ![(!(!Int,!Bool,!Bool,!Int),!String)] !(StrictList (!Info,!String)) -> (!Int,!Int,!StrictList (!Info,!String))
+	parseAfter cln begin i res acc SNil
+		= (begin,dec cln,res (slFromList acc))
+	parseAfter cln begin state=:(lev,def,dec,off) res acc rest=:(SCons h=:(old,l) t)
+		| trace_n` ("parseAfter",cln,state,h) False = undef
+		#! (has_contents,state`=:(level`,def`,dec`,off`)) = parseLine state l
+		   new = (lev,def`,dec`,off`)
+		| dec == False && dec` && off < off`
+			| has_contents
+				#!	res = (\r -> res (slFromList` acc r))
+				| equal_state new old
+					#!	res = res (slFromList` [(new,l)] SNil)
+					= (begin,cln,slAppend res t)
+				= parseDuring (inc cln) begin state` res [(new,l)] t
+			# j` = (lev,def,dec`,off)
+			= parseDuring cln begin j` (\r -> res (slFromList` [fix s \\ s<- acc] r)) [] rest
+		| has_contents
+			#!	res = (\r -> res (slFromList` acc r))
+			| equal_state new old
+				#!	res = res (slFromList` [(new,l)] SNil)
+				= (begin,cln,slAppend res t)
+			= parseDuring (inc cln) begin state` res [(new,l)] t
+		= parseDuring (inc cln) begin state` res (acc ++[(new,l)]) t
+	where
+		fix :: (!Info,!String) -> (!Info,!String)
+		fix ((c,t,d,o),l) = ((c,False,True,o),l)
 
+		equal_state :: !Info !Info -> Bool
+		equal_state (lev,def,dec,off) (lev`,def`,dec`,off`)
+			=	lev == lev`
+			&&	def == def`
+			&&	dec == dec`
+			&&	off == off`

HeapProfile/ShowHeapProfile.icl

@@ -1398,7 +1398,7 @@ open_file_function file_name s=:{application_name,current_page,file_open} io
 	= (s, io);
 */			
 
-set_page_number :: !String !Int -> !String;
+set_page_number :: !String !Int -> String;
 set_page_number file_name new_page_number
 	= file_name := (size file_name-PageNumberOffsetFromEndInFileName,toChar (new_page_number + toInt '0'));
 

Ide/IdeState.icl

@@ -484,7 +484,7 @@ setPrefix s ps = appPLoc (\p=:{prefix}->{p & prefix = removeDup [s:prefix]}) ps
 //-- batch build support
 from StdProcess import closeProcess
 from StdPStClass import class FileSystem, instance FileSystem PSt
-import logfile, set_return_code
+import logfile, Platform
 
 getInteract  :: !*(PSt *General) -> (!Bool,!*PSt *General)
 getInteract ps = accPLoc (\p=:{interact}->(interact,p)) ps 
@@ -506,7 +506,7 @@ abortLog flag message ps
 	# (ok,ps)	= closeLogfile lf ps
 //	| not ok ...
 	# ps = case flag of
-		True	-> set_return_code_pst (-1) ps
+		True	-> pAbort ps
 		_		-> ps
 	= closeProcess ps
 

Mac/Platform.dcl

@@ -9,6 +9,9 @@ initPlatformCommandLine			:: !*(PSt .l) -> (![String],!*PSt .l)
 installPlatformEventHandlers	:: !*(PSt .l) -> *(PSt .l)
 openPlatformWindowMenu			:: !*(PSt .l) -> *(PSt .l)
 
+getWindowModified :: !Id !(IOSt .l) -> (!Maybe Bool,!IOSt .l)
+setWindowModified :: !Id !String !Bool !(IOSt .l) -> IOSt .l
+
 TempDir	:: String
 EnvsDir		:: String
 PrefsDir	:: String
@@ -16,3 +19,4 @@ BitmapDir	:: String
 
 batchOptions	:: !*World -> (!Bool,Bool,String,*File,!*World)
 wAbort			:: !String !*World -> *World
+pAbort			:: !(PSt .a) -> PSt .a

Mac/Platform.icl

@@ -39,6 +39,9 @@ wAbort message world
 	# (_,world)	= fclose stderr world
 	= world
 
+pAbort			:: !(PSt .a) -> PSt .a
+pAbort ps = ps
+
 install_apple_event_handlers :: Int
 install_apple_event_handlers
 	= code ()(r=D0) {
@@ -56,3 +59,60 @@ PrefsDir = applicationpath "Config"
 
 BitmapDir	:: String
 BitmapDir = applicationpath "Bitmaps"
+
+//////////////
+
+//import dodebug
+trace_n` _ f :== f
+
+import windowaccess, iostate, StdBool,menuwindowmenu
+import code from library "winmod_library"
+
+getWindowModified :: !Id !(IOSt .l) -> (!Maybe Bool,!IOSt .l)
+getWindowModified id ioState
+	# (found,wDevice,ioState)	= ioStGetDevice WindowDevice ioState
+	| not found
+		= (Nothing,ioState)
+	# windows					= windowSystemStateGetWindowHandles wDevice
+	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
+	| not found
+		= (Nothing,ioStSetDevice (WindowSystemState windows) ioState)
+	| otherwise
+		# (mod,wsH,ioState)		= getWindowModified wsH ioState
+		= (Just mod,ioStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState)
+where
+	getWindowModified wsH=:{wshIds={wPtr}} ioState
+		# (mod,ioState)			= accIOToolbox (IsWindowModified wPtr) ioState
+		= trace_n` ("getWindowModified",wPtr,mod) (mod,wsH,ioState)
+	
+	IsWindowModified :: !OSWindowPtr !*OSToolbox -> (!Bool,!*OSToolbox)
+	IsWindowModified wPtr ioState = code {
+		ccall IsWindowModified "PI:I:I"
+		}
+
+setWindowModified :: !Id !String !Bool !(IOSt .l) -> IOSt .l
+setWindowModified id windowName mod ioState
+	# windowTitle				= if mod (""+++windowName) windowName
+	# ioState					= changeWindowInWindowMenu id windowTitle ioState
+
+	# (found,wDevice,ioState)	= ioStGetDevice WindowDevice ioState
+	| not found
+		= ioState
+	# windows					= windowSystemStateGetWindowHandles wDevice
+	  (found,wsH,windows)		= getWindowHandlesWindow (toWID id) windows
+	| not found
+		= ioStSetDevice (WindowSystemState windows) ioState
+	| otherwise
+		# (wsH,ioState)			= setWindowModified wsH mod ioState
+		= ioStSetDevice (WindowSystemState (setWindowHandlesWindow wsH windows)) ioState
+where
+	setWindowModified wsH=:{wshIds={wPtr}} mod ioState
+		# (err,ioState)			= accIOToolbox (SetWindowModified wPtr (if mod (1 << 24) 0)) ioState
+		= trace_n` ("setWindowModified",wPtr,mod,err) (wsH,ioState)
+	
+	SetWindowModified :: !OSWindowPtr !Int !*OSToolbox -> (!OSStatus,!*OSToolbox)
+	SetWindowModified wPtr mod ioState = code {
+		ccall SetWindowModified "PII:I:I"
+		}
+
+:: OSStatus	:== Int

Mac/UtilIO.dcl

@@ -28,6 +28,8 @@ GetShortPathName :: !String -> (!Bool,!String);
 
 import StdPSt, StdMaybe
 
+selectInputFile`		:: !(PSt .l) -> (!Maybe String,!(PSt .l))
+selectOutputFile`		:: !String !String !String !(PSt .l) -> (!Maybe String,!(PSt .l))
 selectDirectory`		:: !(PSt .l) -> (!Maybe String,!(PSt .l))
 ShellDefault :: !{#Char} !(PSt .l) -> (!Int,!(PSt .l))
 

Mac/UtilIO.icl

@@ -153,6 +153,14 @@ GetFName ioNamePtr t = code (ioNamePtr=R80O0D0SD1,t=U)(ioResult=D0,ioDate_and_Ti
 
 import StdFileSelect, StdPSt, StdPStClass
 
+selectInputFile` :: !(PSt .l) -> (!Maybe String,!(PSt .l))
+selectInputFile` ps
+	= selectInputFile ps
+
+selectOutputFile` :: !String !String !String !(PSt .l) -> (!Maybe String,!(PSt .l))
+selectOutputFile` prompt filename ok ps
+	= selectOutputFile prompt filename ps
+
 selectDirectory` :: !(PSt .l) -> (!Maybe String,!PSt .l)
 selectDirectory` ps
 	# (ms,ps)	= selectDirectory ps

Util/ExtListBox.icl

@@ -588,7 +588,7 @@ applySelfun ls=:{newselfun,selection} ps
 	= (ls,ps)
 	
 //	The mouse either sets, adds, or removes items to the selection:
-mouseFunction :: !.MouseState *((.ExtListBoxState *(PSt .a),.b),*PSt .a) -> *((ExtListBoxState *(PSt .a),.b),*PSt .a);
+//mouseFunction :: !.MouseState *((.ExtListBoxState *(PSt .a),.b),*PSt .a) -> *((ExtListBoxState *(PSt .a),.b),*PSt .a);
 mouseFunction (MouseDown pos {shiftDown,controlDown} 1) ((listboxState=:{tMargin,items,selection,lineHeight,initHeight},ls),ps)
 	# listboxState				= {ExtListBoxState | listboxState & selection=okSelection}
 	# (listboxState,ps)			= applySelfun listboxState ps